AGGRFCE ;VNGT/HS/ALA-FACE Sheet ; 28 Apr 2010 11:40 AM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
Q
;
EN(DATA,DFN) ; EP -- AGG PATIENT FACE SHEET
;Description
; Generates a Patient Face Sheet for a given DFN
;
;Input
; DFN - Patient Internal ID
;
;Output
; DATA - Name of global in which data is stored(^TMP("AGGRFCE"))
;
NEW UID,X,II,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N,RHIFLAG,RHI,NLN,AGG
NEW %I,AGDENT,AGQI,AGQT,AGTP,C,DA,DG20NAME,DGNEWVAL,DIC,DIW,DIWT,DN,DR,REC
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGRFCE",UID))
K @DATA
;
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGRFCE D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S RHI="",TEXT=""
S IOSL=999,IOM=80,IOST="P-OTHER80"
S IOST(0)=$$FIND1^DIC(3.2,,"X",IOST)
D CHKRHI^AG
I $G(RHIFLAG)'="",RHIFLAG="A" S RHI="This patient has Restricted Health Information"
;
D HDR
;
I $$TMPFL^AGGUL1("W",UID,DFN) G DONE
;
K AG,AGOPT
D ^AGDATCK
I AG("DTOT")>0 D ^AGGRFCRQ
I $D(AGG)>1 S TEXT="",NLN="" F S NLN=$O(AGG(NLN)) Q:NLN="" S TEXT=TEXT_AGG(NLN)_$C(10)
S TEXT=$$TKO^AGGUL1(TEXT,$C(10))
S AGVQQFS=1
U IO D START^AGFACE
U IO W $C(9)
;
K AGVQQFS
;
I $$TMPFL^AGGUL1("C") G DONE
I $$TMPFL^AGGUL1("R",UID,DFN) G DONE
;
S II=II+1,@DATA@(II)=RHI_"^"_TEXT_"^"
F U IO R HSTEXT:.1 Q:HSTEXT[$C(9) D
. S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^"),HSTEXT=$$CTRL^AGGUL1(HSTEXT)
. I HSTEXT="" S HSTEXT=" "
. S II=II+1,@DATA@(II)=HSTEXT_$C(13)_$C(10)
S II=II+1,@DATA@(II)=$C(30)
;
I $$TMPFL^AGGUL1("C") G DONE
I $$TMPFL^AGGUL1("D",UID,DFN) G DONE
;
DONE ;
;
S II=II+1,@DATA@(II)=$C(31)
K AG,AGOPT
Q
;
HDR ;
S @DATA@(II)="T00120RHI_MSG^T01024WARN_TEXT^T02048REPORT_TEXT"_$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)
I $$TMPFL^AGGUL1("C")
Q
AGGRFCE ;VNGT/HS/ALA-FACE Sheet ; 28 Apr 2010 11:40 AM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
+4 QUIT
+5 ;
EN(DATA,DFN) ; EP -- AGG PATIENT FACE SHEET
+1 ;Description
+2 ; Generates a Patient Face Sheet for a given DFN
+3 ;
+4 ;Input
+5 ; DFN - Patient Internal ID
+6 ;
+7 ;Output
+8 ; DATA - Name of global in which data is stored(^TMP("AGGRFCE"))
+9 ;
+10 NEW UID,X,II,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N,RHIFLAG,RHI,NLN,AGG
+11 NEW %I,AGDENT,AGQI,AGQT,AGTP,C,DA,DG20NAME,DGNEWVAL,DIC,DIW,DIWT,DN,DR,REC
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("AGGRFCE",UID))
+14 KILL @DATA
+15 ;
+16 SET II=0
+17 ;
+18 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGRFCE D UNWIND^%ZTER"
+19 ;
+20 SET RHI=""
SET TEXT=""
+21 SET IOSL=999
SET IOM=80
SET IOST="P-OTHER80"
+22 SET IOST(0)=$$FIND1^DIC(3.2,,"X",IOST)
+23 DO CHKRHI^AG
+24 IF $GET(RHIFLAG)'=""
IF RHIFLAG="A"
SET RHI="This patient has Restricted Health Information"
+25 ;
+26 DO HDR
+27 ;
+28 IF $$TMPFL^AGGUL1("W",UID,DFN)
GOTO DONE
+29 ;
+30 KILL AG,AGOPT
+31 DO ^AGDATCK
+32 IF AG("DTOT")>0
DO ^AGGRFCRQ
+33 IF $DATA(AGG)>1
SET TEXT=""
SET NLN=""
FOR
SET NLN=$ORDER(AGG(NLN))
IF NLN=""
QUIT
SET TEXT=TEXT_AGG(NLN)_$CHAR(10)
+34 SET TEXT=$$TKO^AGGUL1(TEXT,$CHAR(10))
+35 SET AGVQQFS=1
+36 USE IO
DO START^AGFACE
+37 USE IO
WRITE $CHAR(9)
+38 ;
+39 KILL AGVQQFS
+40 ;
+41 IF $$TMPFL^AGGUL1("C")
GOTO DONE
+42 IF $$TMPFL^AGGUL1("R",UID,DFN)
GOTO DONE
+43 ;
+44 SET II=II+1
SET @DATA@(II)=RHI_"^"_TEXT_"^"
+45 FOR
USE IO
READ HSTEXT:.1
IF HSTEXT[$CHAR(9)
QUIT
Begin DoDot:1
+46 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
SET HSTEXT=$$CTRL^AGGUL1(HSTEXT)
+47 IF HSTEXT=""
SET HSTEXT=" "
+48 SET II=II+1
SET @DATA@(II)=HSTEXT_$CHAR(13)_$CHAR(10)
End DoDot:1
+49 SET II=II+1
SET @DATA@(II)=$CHAR(30)
+50 ;
+51 IF $$TMPFL^AGGUL1("C")
GOTO DONE
+52 IF $$TMPFL^AGGUL1("D",UID,DFN)
GOTO DONE
+53 ;
DONE ;
+1 ;
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 KILL AG,AGOPT
+4 QUIT
+5 ;
HDR ;
+1 SET @DATA@(II)="T00120RHI_MSG^T01024WARN_TEXT^T02048REPORT_TEXT"_$CHAR(30)
+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 IF $$TMPFL^AGGUL1("C")
+7 QUIT
