BQIRHS.m

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