BQIVFCHC ;PRXM/HC/ALA-Return 'Choice' values for the GUI ; 09 Apr 2007 4:33 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
Q
;
EN(DATA,VFILE,CODE) ;EP -- BQI GET VFILE CHOICE
;
;Input
; VFILE - The vfile number or name
; CODE - The parameter name
;
NEW UID,II,HDR,IEN,VALUE,HELP,VFIEN,HN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIVFCHC",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="No Vfile selected" Q
S VFIEN=$$FIND1^DIC(90506.3,"","M",VFILE,"","","ERROR")
S CODE=$G(CODE,"") I CODE="" S BMXSEC="No code given" Q
I $O(^BQI(90506.3,VFIEN,10,"AC",CODE,""))="" S BMXSEC="Code does not exist for this Vfile" Q
NEW DA,IENS
S DA(2)=VFIEN
;
S HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE^T00001VALIDATION^T00008HELP_ASSOC^T01024CHOICE_HELP"_$C(30)
S @DATA@(II)=HDR
;
NEW CIEN
S CIEN=""
F S CIEN=$O(^BQI(90506.3,VFIEN,10,"AC",CODE,CIEN)) Q:CIEN="" D
. I $P(^BQI(90506.3,VFIEN,10,CIEN,0),U,11)=1 Q
. S DA(1)=CIEN
;
I $G(DA(1))]"" D
. I $O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",""))="" D STD
. I $O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",""))'="" D NST
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
NST ; Sort in designated order
NEW ORD
S ORD=""
F S ORD=$O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",ORD,IEN)) Q:IEN="" D REC
Q
;
STD ; Sort in standard order
S IEN=0
F S IEN=$O(^BQI(90506.3,VFIEN,10,DA(1),5,IEN)) Q:'IEN D REC
Q
;
REC ; Get record values
I $P(^BQI(90506.3,VFIEN,10,DA(1),5,IEN,0),U,5)=1 Q
S DA=IEN,IENS=$$IENS^DILF(.DA),VALUE=""
S VALUE=VALUE_$$GET1^DIQ(90506.315,IENS,.01,"E")_U_$$GET1^DIQ(90506.315,IENS,.02,"E")_U_$$GET1^DIQ(90506.315,IENS,.03,"I")_U
S VALUE=VALUE_$$GET1^DIQ(90506.315,IENS,.04,"E")_U
S HN=0,HELP=""
F S HN=$O(^BQI(90506.3,VFIEN,10,DA(1),5,IEN,1,HN)) Q:'HN D
. S HELP=HELP_^BQI(90506.3,VFIEN,10,DA(1),5,IEN,1,HN,0)_$C(10)
S HELP=$$TKO^BQIUL1(HELP,$C(10))
S VALUE=VALUE_HELP_$C(30)
S II=II+1,@DATA@(II)=VALUE
Q
;
CMET(DATA,FAKE) ;EP -- BQI GET CMET CHOICE
NEW UID,II,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICMETCH",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE"
S @DATA@(II)=HDR_$C(30)
S TEXT=$P(^DD(90505,.09,0),U,3)
F BQ=1:1:$L(TEXT,";") S VAL=$P(TEXT,";",BQ) Q:VAL="" D
. S II=II+1,@DATA@(II)=$P(VAL,":",2)_U_$P(VAL,":",1)_$C(30)
G DONE
;
MU(DATA,FAKE) ;EP -- BQI GET MU CHOICE
NEW UID,II,HDR,TEXT,BQ,VAL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUCH",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S HDR="T00005CHOICE_CODE^T00020CHOICE_TEXT^T00001CHOICE_TAB"
S @DATA@(II)=HDR_$C(30)
S BQ=0
F S BQ=$O(^BQI(90506.71,BQ)) Q:'BQ D
. ;S TEXT=$P(^BQI(90506.71,BQ,0),U,2)
. S II=II+1,@DATA@(II)=^BQI(90506.71,BQ,0)_$C(30)
G DONE
BQIVFCHC ;PRXM/HC/ALA-Return 'Choice' values for the GUI ; 09 Apr 2007 4:33 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 QUIT
+3 ;
EN(DATA,VFILE,CODE) ;EP -- BQI GET VFILE CHOICE
+1 ;
+2 ;Input
+3 ; VFILE - The vfile number or name
+4 ; CODE - The parameter name
+5 ;
+6 NEW UID,II,HDR,IEN,VALUE,HELP,VFIEN,HN
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQIVFCHC",UID))
+9 KILL @DATA
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER"
+12 SET VFILE=$GET(VFILE,"")
IF VFILE=""
SET BMXSEC="No Vfile selected"
QUIT
+13 SET VFIEN=$$FIND1^DIC(90506.3,"","M",VFILE,"","","ERROR")
+14 SET CODE=$GET(CODE,"")
IF CODE=""
SET BMXSEC="No code given"
QUIT
+15 IF $ORDER(^BQI(90506.3,VFIEN,10,"AC",CODE,""))=""
SET BMXSEC="Code does not exist for this Vfile"
QUIT
+16 NEW DA,IENS
+17 SET DA(2)=VFIEN
+18 ;
+19 SET HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE^T00001VALIDATION^T00008HELP_ASSOC^T01024CHOICE_HELP"_$CHAR(30)
+20 SET @DATA@(II)=HDR
+21 ;
+22 NEW CIEN
+23 SET CIEN=""
+24 FOR
SET CIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",CODE,CIEN))
IF CIEN=""
QUIT
Begin DoDot:1
+25 IF $PIECE(^BQI(90506.3,VFIEN,10,CIEN,0),U,11)=1
QUIT
+26 SET DA(1)=CIEN
End DoDot:1
+27 ;
+28 IF $GET(DA(1))]""
Begin DoDot:1
+29 IF $ORDER(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",""))=""
DO STD
+30 IF $ORDER(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",""))'=""
DO NST
End DoDot:1
+31 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
NST ; Sort in designated order
+1 NEW ORD
+2 SET ORD=""
+3 FOR
SET ORD=$ORDER(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",ORD,IEN))
IF IEN=""
QUIT
DO REC
End DoDot:1
+6 QUIT
+7 ;
STD ; Sort in standard order
+1 SET IEN=0
+2 FOR
SET IEN=$ORDER(^BQI(90506.3,VFIEN,10,DA(1),5,IEN))
IF 'IEN
QUIT
DO REC
+3 QUIT
+4 ;
REC ; Get record values
+1 IF $PIECE(^BQI(90506.3,VFIEN,10,DA(1),5,IEN,0),U,5)=1
QUIT
+2 SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
SET VALUE=""
+3 SET VALUE=VALUE_$$GET1^DIQ(90506.315,IENS,.01,"E")_U_$$GET1^DIQ(90506.315,IENS,.02,"E")_U_$$GET1^DIQ(90506.315,IENS,.03,"I")_U
+4 SET VALUE=VALUE_$$GET1^DIQ(90506.315,IENS,.04,"E")_U
+5 SET HN=0
SET HELP=""
+6 FOR
SET HN=$ORDER(^BQI(90506.3,VFIEN,10,DA(1),5,IEN,1,HN))
IF 'HN
QUIT
Begin DoDot:1
+7 SET HELP=HELP_^BQI(90506.3,VFIEN,10,DA(1),5,IEN,1,HN,0)_$CHAR(10)
End DoDot:1
+8 SET HELP=$$TKO^BQIUL1(HELP,$CHAR(10))
+9 SET VALUE=VALUE_HELP_$CHAR(30)
+10 SET II=II+1
SET @DATA@(II)=VALUE
+11 QUIT
+12 ;
CMET(DATA,FAKE) ;EP -- BQI GET CMET CHOICE
+1 NEW UID,II,HDR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQICMETCH",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER"
+7 SET HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE"
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 SET TEXT=$PIECE(^DD(90505,.09,0),U,3)
+10 FOR BQ=1:1:$LENGTH(TEXT,";")
SET VAL=$PIECE(TEXT,";",BQ)
IF VAL=""
QUIT
Begin DoDot:1
+11 SET II=II+1
SET @DATA@(II)=$PIECE(VAL,":",2)_U_$PIECE(VAL,":",1)_$CHAR(30)
End DoDot:1
+12 GOTO DONE
+13 ;
MU(DATA,FAKE) ;EP -- BQI GET MU CHOICE
+1 NEW UID,II,HDR,TEXT,BQ,VAL
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIMUCH",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER"
+7 SET HDR="T00005CHOICE_CODE^T00020CHOICE_TEXT^T00001CHOICE_TAB"
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 SET BQ=0
+10 FOR
SET BQ=$ORDER(^BQI(90506.71,BQ))
IF 'BQ
QUIT
Begin DoDot:1
+11 ;S TEXT=$P(^BQI(90506.71,BQ,0),U,2)
+12 SET II=II+1
SET @DATA@(II)=^BQI(90506.71,BQ,0)_$CHAR(30)
End DoDot:1
+13 GOTO DONE
