DVBACPR1 ;ALB/GAK - PATCH DVBA*2.7*189 introduced field utility RPCs;08/08/2014
 ;;2.7;AMIE;**189**;Apr 10, 1995;Build 22
 ; This routine provides list, get and set features for several CAPRI RPCs
 
Q
 
;
LSTCT(RTRN) ;
 ;LIST VALID CLAIM TYPES
 ;RPC: DVBA CAPRI LISTCLAIMTYPE
 
CTIEN,CODE,CTR
 
^TEMP($J,"LSTCT")
 
CTIEN=0
 
F  S CTIEN=$O(^DVB(396.27,CTIEN)) Q:CTIEN=""!('CTIEN)  D
 
Q:$G(^DVB(396.27,CTIEN,0))=""
 
^TEMP($J,"LSTCT",$P(^DVB(396.27,CTIEN,0),"^",1))=CTIEN
 
CODE="",CTR=0
 
F  S CODE=$O(^TEMP($J,"LSTCT",CODE)) Q:CODE=""  D
 
CTR=CTR+1
 . 
RTRN(CTR)=CODE_"^"_^TEMP($J,"LSTCT",CODE)
 
^TEMP($J,"LSTCT")
 
Q
 
;
GETCT(RTRN,REQIEN) ;
 ;GET CLAIM TYPE
 ;RPC: DVBA CAPRI GETCLAIMTYPE
 
I $G(REQIEN)="" RTRN(1)="INVALID REQUEST IEN" Q
 I 
'$D(^DVB(396.3,$G(REQIEN))) RTRN(1)="INVALID REQUEST IEN" Q
 N 
MSG,ERR,CTR,MSGIEN,FIND,OUT
 
GETS^DIQ(396.3,REQIEN_",","9.1*","E","MSG","ERR")
 
I $D(ERR)>1 RTRN(1)="NO CLAIM TYPE ON FILE" Q
 S 
CTR=0
 
MSGIEN="" F  S MSGIEN=$O(MSG(396.32,MSGIEN)) Q:MSGIEN=""  D
 
CTR=CTR+1
 . 
FIND,OUT
 
FIND=MSG(396.32,MSGIEN,.01,"E")
 . 
FIND^DIC(396.27,"",.01,"",.FIND,"","","","","OUT")
 . 
RTRN(CTR)=MSG(396.32,MSGIEN,.01,"E")_"^"_$G(OUT("DILIST",2,1))
 
Q
 
;
SETCT(RTRN,REQIEN,ARRAYCT) ;
 ;SET CLAIM TYPE
 ;RPC: DVBA CAPRI SETCLAIMTYPE
 ;
 
VAL,SUB,DA,DIK
 
VAL="" F  S VAL=$O(^DVB(396.3,REQIEN,9,"B",VAL)) Q:VAL=""  D
 
SUB="" F  S SUB=$O(^DVB(396.3,REQIEN,9,"B",VAL,SUB)) Q:SUB=""  
 
.. DA,DIK
 
.. DA(1)=REQIEN
 
.. DA=SUB
 
.. DIK="^DVB(396.3,"_DA(1)_",""9"","
 
.. ^DIK
 
;
 
I $G(REQIEN)="" RTRN(1)="INVALID REQUEST IEN" Q
 I 
'$D(^DVB(396.3,$G(REQIEN))) RTRN(1)="INVALID EXAM IEN" Q
 N 
ARYIEN,CTR,FDA,ERR,KEYIEN,FIND
 
CTR=0
 
ARYIEN="" F  S ARYIEN=$O(ARRAYCT(ARYIEN)) Q:ARYIEN=""  D
 
CTR=CTR+1
 . 
FIND,OUT
 
FIND=ARRAYCT(ARYIEN)
 . 
FIND^DIC(396.27,"",.01,"",.FIND,"","","","","OUT")
 . 
I $G(OUT("DILIST",2,1))="" RTRN(CTR)=FIND_"^"_"NOT A VALID CLAIM TYPE" Q
 
FDA,ERR,KEYIEN
 
KEYIEN=OUT("DILIST",2,1)
 . 
FDA(396.32,"+2,"_REQIEN_",",.01)=KEYIEN
 
UPDATE^DIE("","FDA","KEYIEN","ERR")
 . 
I $D(ERR)>1 RTRN(CTR)=FIND_"^"_"COULD NOT BE FILED" Q
 
RTRN(CTR)=FIND_"^"_"FILED"
 ;
 
Q
 
;
LSTSC(RTRN) ;
 ;LIST SPECIAL CONSIDERATION
 ;RPC: DVBA CAPRI LISTSPCLCONSID
 
SCIEN,CTR,CODE
 
^TEMP($J,"LSTSC")
 
SCIEN=0
 
F  S SCIEN=$O(^DVB(396.25,SCIEN)) Q:SCIEN=""!('SCIEN)  D
 
Q:$G(^DVB(396.25,SCIEN,0))=""
 
^TEMP($J,"LSTSC",$P(^DVB(396.25,SCIEN,0),"^",1))=SCIEN
 
CODE="",CTR=0
 
F  S CODE=$O(^TEMP($J,"LSTSC",CODE)) Q:CODE=""  D
 
CTR=CTR+1
 . 
RTRN(CTR)=CODE_"^"_^TEMP($J,"LSTSC",CODE)
 
^TEMP($J,"LSTSC")
 
Q
 
;
GETSC(RTRN,REQIEN) ;
 ;GET SPECIAL CONSIDERATION
 ;RPC: DVBA CAPRI GETSPCLCONSID
 
I $G(REQIEN)="" RTRN(1)="INVALID REQUEST IEN" Q
 I 
'$D(^DVB(396.3,$G(REQIEN))) RTRN(1)="INVALID REQUEST IEN" Q
 N 
MSG,ERR,CTR,MSGIEN,FIND,OUT
 
GETS^DIQ(396.3,REQIEN_",","50*","E","MSG","ERR")
 
I $D(ERR)>1 RTRN(1)="NO SPECIAL CONSIDERATIONS ON FILE" Q
 S 
CTR=0
 
MSGIEN="" F  S MSGIEN=$O(MSG(396.31,MSGIEN)) Q:MSGIEN=""  D
 
CTR=CTR+1
 . 
FIND,OUT
 
FIND=MSG(396.31,MSGIEN,.01,"E")
 . 
FIND^DIC(396.25,"",.01,"",.FIND,"","","","","OUT")
 . 
RTRN(CTR)=MSG(396.31,MSGIEN,.01,"E")_"^"_$G(OUT("DILIST",2,1))
 
Q
 
;
SETSC(RTRN,REQIEN,ARRAYSC) ;
 ;SET SPECIAL CONSIDERATION
 ;RPC: DVBA CAPRI SETSPCLCONSID
 ;
 
VAL,SUB,DA,DIK
 
VAL="" F  S VAL=$O(^DVB(396.3,REQIEN,8,"B",VAL)) Q:VAL=""  D
 
SUB="" F  S SUB=$O(^DVB(396.3,REQIEN,8,"B",VAL,SUB)) Q:SUB=""  
 
.. DA,DIK
 
.. DA(1)=REQIEN
 
.. DA=SUB
 
.. DIK="^DVB(396.3,"_DA(1)_",""8"","
 
.. ^DIK
 
;
 
I $G(REQIEN)="" RTRN(1)="INVALID REQUEST IEN" Q
 I 
'$D(^DVB(396.3,$G(REQIEN))) RTRN(1)="INVALID REQUEST IEN" Q
 N 
ARYIEN,CTR,FDA,ERR,KEYIEN,FIND
 
CTR=0
 
ARYIEN="" F  S ARYIEN=$O(ARRAYSC(ARYIEN)) Q:ARYIEN=""  D
 
CTR=CTR+1
 . 
FIND,OUT
 
FIND=ARRAYSC(ARYIEN)
 . 
FIND^DIC(396.25,"",.01,"",.FIND,"","","","","OUT")
 . 
I $G(OUT("DILIST",2,1))="" RTRN(CTR)=FIND_"^"_"NOT A VALID SPECIAL CONSIDERATION" Q
 
FDA,ERR,KEYIEN
 
KEYIEN=OUT("DILIST",2,1)
 . 
FDA(396.31,"+2,"_REQIEN_",",.01)=KEYIEN
 
UPDATE^DIE("","FDA","KEYIEN","ERR")
 . 
I $D(ERR)>1 RTRN(CTR)=FIND_"^"_"COULD NOT BE FILED" Q
 
RTRN(CTR)=FIND_"^"_"FILED"
 ;
 
Q
 
;
LSTIR(RTRN) ;
 ;LIST INSUFFICIENT REASON
 ;RPC: DVBA CAPRI LISTINSUFRSN
 ;FILE #396.4 FIELD .11 --> FILE #396.94
 ;BUILD LIST OF VALID (ACTIVE) REASONS
 
IRIEN,CTR,CODE
 
^TEMP($J,"LSTIR")
 
IRIEN=0
 
F  S IRIEN=$O(^DVB(396.94,IRIEN)) Q:IRIEN=""!('IRIEN)  D
 
Q:$G(^DVB(396.94,IRIEN,0))=""
 
Q:$P(^DVB(396.94,IRIEN,0),"^",4)="Y"
 
^TEMP($J,"LSTIR",$P(^DVB(396.94,IRIEN,0),"^",1))=IRIEN
 
CODE="",CTR=0
 
F  S CODE=$O(^TEMP($J,"LSTIR",CODE)) Q:CODE=""  D
 
CTR=CTR+1
 . 
RTRN(CTR)=CODE_"^"_^TEMP($J,"LSTIR",CODE)
 
Q
 
;