- BQIRHS ;PRXM/HC/DLS - Patient Health Summary ; 20 Dec 2005 3:53 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- EN(DATA,DFN,SUMMTYP) ; EP -- BQI PATIENT HEALTH SUMMARY
- ;Description
- ; Generates a Patient Health Summary for a given DFN
- ;
- ;Input
- ; DFN - Patient Internal ID
- ; SUMMTYP - Health Summary Type ID
- ;
- ;Output
- ; DATA - Name of global in which data is stored(^TMP("BQIRHS"))
- ;
- N UID,X,BQII,HSOS
- N HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N
- N APCHSPAT,APCHSTYP
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIRHS",UID))
- K @DATA
- ;
- S BQII=0
- ;
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRHS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- D HDR
- ;
- ;S HSPATH=$$DEFDIR^%ZISH("")
- ;I HSPATH="" S HSPATH=$$PWD^%ZISH()
- ;S HSFN=UID_"_"_DFN_".DAT"
- ;D OPEN^%ZISH("BQIFILE",HSPATH,HSFN,"W") I POP G DONE
- I $$TMPFL^BQIUL1("W",UID,DFN) G DONE
- ;
- S IOSL=999,IOM=80,IOST="P-OTHER80"
- S APCHSPAT=DFN ; APCHSPAT variable is required by APCHS.
- S APCHSTYP=SUMMTYP ; APCHSTYP variable is required by APCHS.
- ;
- U IO D EN^APCHS
- U IO W $C(9)
- ;
- ;D CLOSE^%ZISH("BQIFILE")
- I $$TMPFL^BQIUL1("C") G DONE
- ;D OPEN^%ZISH("BQIFILE",HSPATH,HSFN,"R") I POP G DONE
- I $$TMPFL^BQIUL1("R",UID,DFN) G DONE
- ;
- F U IO R HSTEXT:.1 Q:HSTEXT[$C(9) D
- . S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
- . I HSTEXT="" S HSTEXT=" "
- . S BQII=BQII+1,@DATA@(BQII)=HSTEXT_$C(13)_$C(10)
- S BQII=BQII+1,@DATA@(BQII)=$C(30)
- ;
- ;Drop down to DONE.
- ;
- ;D CLOSE^%ZISH("BQIFILE")
- I $$TMPFL^BQIUL1("C") G DONE
- ;S Y=$$DEL^%ZISH(HSPATH,HSFN)
- I $$TMPFL^BQIUL1("D",UID,DFN) G DONE
- ;
- DONE ;
- ;
- S BQII=BQII+1,@DATA@(BQII)=$C(31)
- Q
- ;
- HDR ;
- S @DATA@(BQII)="T00120REPORT_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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
- I $$TMPFL^BQIUL1("C")
- Q
- BQIRHS ;PRXM/HC/DLS - Patient Health Summary ; 20 Dec 2005 3:53 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- EN(DATA,DFN,SUMMTYP) ; EP -- BQI PATIENT HEALTH SUMMARY
- +1 ;Description
- +2 ; Generates a Patient Health Summary for a given DFN
- +3 ;
- +4 ;Input
- +5 ; DFN - Patient Internal ID
- +6 ; SUMMTYP - Health Summary Type ID
- +7 ;
- +8 ;Output
- +9 ; DATA - Name of global in which data is stored(^TMP("BQIRHS"))
- +10 ;
- +11 NEW UID,X,BQII,HSOS
- +12 NEW HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N
- +13 NEW APCHSPAT,APCHSTYP
- +14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +15 SET DATA=$NAME(^TMP("BQIRHS",UID))
- +16 KILL @DATA
- +17 ;
- +18 SET BQII=0
- +19 ;
- +20 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIRHS D UNWIND^%ZTER"
- +21 ;
- +22 DO HDR
- +23 ;
- +24 ;S HSPATH=$$DEFDIR^%ZISH("")
- +25 ;I HSPATH="" S HSPATH=$$PWD^%ZISH()
- +26 ;S HSFN=UID_"_"_DFN_".DAT"
- +27 ;D OPEN^%ZISH("BQIFILE",HSPATH,HSFN,"W") I POP G DONE
- +28 IF $$TMPFL^BQIUL1("W",UID,DFN)
- GOTO DONE
- +29 ;
- +30 SET IOSL=999
- SET IOM=80
- SET IOST="P-OTHER80"
- +31 ; APCHSPAT variable is required by APCHS.
- SET APCHSPAT=DFN
- +32 ; APCHSTYP variable is required by APCHS.
- SET APCHSTYP=SUMMTYP
- +33 ;
- +34 USE IO
- DO EN^APCHS
- +35 USE IO
- WRITE $CHAR(9)
- +36 ;
- +37 ;D CLOSE^%ZISH("BQIFILE")
- +38 IF $$TMPFL^BQIUL1("C")
- GOTO DONE
- +39 ;D OPEN^%ZISH("BQIFILE",HSPATH,HSFN,"R") I POP G DONE
- +40 IF $$TMPFL^BQIUL1("R",UID,DFN)
- GOTO DONE
- +41 ;
- +42 FOR
- USE IO
- READ HSTEXT:.1
- IF HSTEXT[$CHAR(9)
- QUIT
- Begin DoDot:1
- +43 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
- +44 IF HSTEXT=""
- SET HSTEXT=" "
- +45 SET BQII=BQII+1
- SET @DATA@(BQII)=HSTEXT_$CHAR(13)_$CHAR(10)
- End DoDot:1
- +46 SET BQII=BQII+1
- SET @DATA@(BQII)=$CHAR(30)
- +47 ;
- +48 ;Drop down to DONE.
- +49 ;
- +50 ;D CLOSE^%ZISH("BQIFILE")
- +51 IF $$TMPFL^BQIUL1("C")
- GOTO DONE
- +52 ;S Y=$$DEL^%ZISH(HSPATH,HSFN)
- +53 IF $$TMPFL^BQIUL1("D",UID,DFN)
- GOTO DONE
- +54 ;
- DONE ;
- +1 ;
- +2 SET BQII=BQII+1
- SET @DATA@(BQII)=$CHAR(31)
- +3 QUIT
- +4 ;
- HDR ;
- +1 SET @DATA@(BQII)="T00120REPORT_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(BQII)
- IF $DATA(DATA)
- SET BQII=BQII+1
- SET @DATA@(BQII)=$CHAR(31)
- +6 IF $$TMPFL^BQIUL1("C")
- +7 QUIT
