AGGWOTH ;VNGT/HS/ALA-Other AGG Window RPCs ; 18 May 2010 1:32 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
LANG(DATA,DFN) ; EP - AGG PATIENT LANGUAGES
;
NEW UID,II,AGIEN,LDA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGWLANG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S AGIEN=$$FIND1^DIC(9009068.3,"","BX","Other Languages","","","ERROR")
I AGIEN=0 S BMXSEC="RPC Failed: Passed in window name "_DEF_" not found" Q
;
S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
;
S DA(1)=DFN,LDA=$O(^AUPNPAT(DFN,86,"B"),-1) I 'LDA D G DONE
. S HEADR="T00040AGGLGOTH^I00010LGIEN",HDATA=""
. S @DATA@(II)=HEADR_$C(30)
. ;S II=II+1,@DATA@(II)=HDATA_$C(30)
;
S IEN=0
I $O(^AUPNPAT(DFN,86,LDA,5,IEN))="" D G DONE
. S HEADR="T00040AGGLGOTH^I00010LGIEN",HDATA=""
. S @DATA@(II)=HEADR_$C(30)
. ;S II=II+1,@DATA@(II)=HDATA_$C(30)
;
F S IEN=$O(^AUPNPAT(DFN,86,LDA,5,IEN)) Q:'IEN D
. S DA(2)=DFN,DA(1)=LDA,DA=IEN
. S IENS=$$IENS^DILF(.DA)
. S HEADR="",HDATA=""
. D REC(IENS)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
;
Q
;
REC(IENS) ;EP
S AGCN=0
F S AGCN=$O(^AGG(9009068.3,AGIEN,10,AGCN)) Q:'AGCN D
. I $P(^AGG(9009068.3,AGIEN,10,AGCN,0),U,11)'="" Q
. S AGDATA=$G(^AGG(9009068.3,AGIEN,10,AGCN,0))
. S FLD=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,1),SECFLD=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,7)
. S TYPE=$P($G(^AGG(9009068.3,AGIEN,10,AGCN,1)),U,1)
. S CODE=$P(AGDATA,U,7),HDR=$P(AGDATA,U,2)
. S DEXEC=$G(^AGG(9009068.3,AGIEN,10,AGCN,8))
. I TYPE="M" S VALUE=""
. I TYPE="T"!(TYPE="C") D
.. I DEXEC'="" D Q
... S VAL=""
... I DEXEC'["DQTY" X DEXEC Q
... S DQTY="I" X DEXEC S VAL=VALUE_$C(28)
... S DQTY="E" X DEXEC S VALUE=VAL_VALUE
.. I FLD'="" S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I")_$C(28)_$$GET1^DIQ(FILE,IENS,FLD,"E") Q
.. S VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"I")_$C(28)_$$GET1^DIQ(SECFILE,IENS,SECFLD,"E")
. I TYPE="X"!(TYPE="N") D
.. NEW TYPE
.. I DEXEC'="" X DEXEC Q
.. I FLD=.001 S VALUE=IEN Q
.. I FLD'="" S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"E") Q
.. S VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"E")
. I TYPE="D" D
.. I DEXEC'="" X DEXEC Q
.. I FLD'="" S VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I"),VALUE=$$FMTE^AGGUL1(VALUE) Q
.. S VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"I"),VALUE=$$FMTE^AGGUL1(VALUE)
. I TYPE="W" D
.. NEW FL,FD
.. K ARRAY S VALUE=""
.. I DEXEC'="" X DEXEC
.. I DEXEC="" D
... I FLD'="" D GETS^DIQ(FILE,DFN_",",FLD,"E","ARRAY") Q
... D GETS^DIQ(SECFILE,DFN_",",SECFLD,"E","ARRAY")
.. S FL=$O(ARRAY("")) I FL="" Q
.. S FD=$O(ARRAY(FL,DFN_",","")) I FD="" Q
.. S AN=0,TXT=ARRAY(FL,DFN_",",FD,"E") I TXT="" Q
.. K @TXT@("E")
.. F S AN=$O(@TXT@(AN)) Q:AN="" S VALUE=VALUE_@TXT@(AN)_$C(10)
. S HEADR=HEADR_HDR_"^"
. S HDATA=HDATA_$G(VALUE)_"^",VALUE=""
S HEADR=$$TKO^AGGUL1(HEADR,"^"),HDATA=$$TKO^AGGUL1(HDATA,"^")
I II=0 S @DATA@(II)=HEADR_$C(30)
S II=II+1,@DATA@(II)=HDATA_$C(30)
;
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
AGGWOTH ;VNGT/HS/ALA-Other AGG Window RPCs ; 18 May 2010 1:32 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
LANG(DATA,DFN) ; EP - AGG PATIENT LANGUAGES
+1 ;
+2 NEW UID,II,AGIEN,LDA
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("AGGWLANG",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER"
+8 ;
+9 SET AGIEN=$$FIND1^DIC(9009068.3,"","BX","Other Languages","","","ERROR")
+10 IF AGIEN=0
SET BMXSEC="RPC Failed: Passed in window name "_DEF_" not found"
QUIT
+11 ;
+12 SET FILE=$PIECE(^AGG(9009068.3,AGIEN,0),U,2)
SET SECFILE=$PIECE(^AGG(9009068.3,AGIEN,0),U,14)
+13 ;
+14 SET DA(1)=DFN
SET LDA=$ORDER(^AUPNPAT(DFN,86,"B"),-1)
IF 'LDA
Begin DoDot:1
+15 SET HEADR="T00040AGGLGOTH^I00010LGIEN"
SET HDATA=""
+16 SET @DATA@(II)=HEADR_$CHAR(30)
+17 ;S II=II+1,@DATA@(II)=HDATA_$C(30)
End DoDot:1
GOTO DONE
+18 ;
+19 SET IEN=0
+20 IF $ORDER(^AUPNPAT(DFN,86,LDA,5,IEN))=""
Begin DoDot:1
+21 SET HEADR="T00040AGGLGOTH^I00010LGIEN"
SET HDATA=""
+22 SET @DATA@(II)=HEADR_$CHAR(30)
+23 ;S II=II+1,@DATA@(II)=HDATA_$C(30)
End DoDot:1
GOTO DONE
+24 ;
+25 FOR
SET IEN=$ORDER(^AUPNPAT(DFN,86,LDA,5,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+26 SET DA(2)=DFN
SET DA(1)=LDA
SET DA=IEN
+27 SET IENS=$$IENS^DILF(.DA)
+28 SET HEADR=""
SET HDATA=""
+29 DO REC(IENS)
End DoDot:1
+30 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 ;
+3 QUIT
+4 ;
REC(IENS) ;EP
+1 SET AGCN=0
+2 FOR
SET AGCN=$ORDER(^AGG(9009068.3,AGIEN,10,AGCN))
IF 'AGCN
QUIT
Begin DoDot:1
+3 IF $PIECE(^AGG(9009068.3,AGIEN,10,AGCN,0),U,11)'=""
QUIT
+4 SET AGDATA=$GET(^AGG(9009068.3,AGIEN,10,AGCN,0))
+5 SET FLD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,1)
SET SECFLD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,AGCN,3)),U,7)
+6 SET TYPE=$PIECE($GET(^AGG(9009068.3,AGIEN,10,AGCN,1)),U,1)
+7 SET CODE=$PIECE(AGDATA,U,7)
SET HDR=$PIECE(AGDATA,U,2)
+8 SET DEXEC=$GET(^AGG(9009068.3,AGIEN,10,AGCN,8))
+9 IF TYPE="M"
SET VALUE=""
+10 IF TYPE="T"!(TYPE="C")
Begin DoDot:2
+11 IF DEXEC'=""
Begin DoDot:3
+12 SET VAL=""
+13 IF DEXEC'["DQTY"
XECUTE DEXEC
QUIT
+14 SET DQTY="I"
XECUTE DEXEC
SET VAL=VALUE_$CHAR(28)
+15 SET DQTY="E"
XECUTE DEXEC
SET VALUE=VAL_VALUE
End DoDot:3
QUIT
+16 IF FLD'=""
SET VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I")_$CHAR(28)_$$GET1^DIQ(FILE,IENS,FLD,"E")
QUIT
+17 SET VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"I")_$CHAR(28)_$$GET1^DIQ(SECFILE,IENS,SECFLD,"E")
End DoDot:2
+18 IF TYPE="X"!(TYPE="N")
Begin DoDot:2
+19 NEW TYPE
+20 IF DEXEC'=""
XECUTE DEXEC
QUIT
+21 IF FLD=.001
SET VALUE=IEN
QUIT
+22 IF FLD'=""
SET VALUE=$$GET1^DIQ(FILE,IENS,FLD,"E")
QUIT
+23 SET VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"E")
End DoDot:2
+24 IF TYPE="D"
Begin DoDot:2
+25 IF DEXEC'=""
XECUTE DEXEC
QUIT
+26 IF FLD'=""
SET VALUE=$$GET1^DIQ(FILE,IENS,FLD,"I")
SET VALUE=$$FMTE^AGGUL1(VALUE)
QUIT
+27 SET VALUE=$$GET1^DIQ(SECFILE,IENS,SECFLD,"I")
SET VALUE=$$FMTE^AGGUL1(VALUE)
End DoDot:2
+28 IF TYPE="W"
Begin DoDot:2
+29 NEW FL,FD
+30 KILL ARRAY
SET VALUE=""
+31 IF DEXEC'=""
XECUTE DEXEC
+32 IF DEXEC=""
Begin DoDot:3
+33 IF FLD'=""
DO GETS^DIQ(FILE,DFN_",",FLD,"E","ARRAY")
QUIT
+34 DO GETS^DIQ(SECFILE,DFN_",",SECFLD,"E","ARRAY")
End DoDot:3
+35 SET FL=$ORDER(ARRAY(""))
IF FL=""
QUIT
+36 SET FD=$ORDER(ARRAY(FL,DFN_",",""))
IF FD=""
QUIT
+37 SET AN=0
SET TXT=ARRAY(FL,DFN_",",FD,"E")
IF TXT=""
QUIT
+38 KILL @TXT@("E")
+39 FOR
SET AN=$ORDER(@TXT@(AN))
IF AN=""
QUIT
SET VALUE=VALUE_@TXT@(AN)_$CHAR(10)
End DoDot:2
+40 SET HEADR=HEADR_HDR_"^"
+41 SET HDATA=HDATA_$GET(VALUE)_"^"
SET VALUE=""
End DoDot:1
+42 SET HEADR=$$TKO^AGGUL1(HEADR,"^")
SET HDATA=$$TKO^AGGUL1(HDATA,"^")
+43 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+44 SET II=II+1
SET @DATA@(II)=HDATA_$CHAR(30)
+45 ;
+46 QUIT
+47 ;
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
