- 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
