BQIRPASM ;VNGT/HS/ALA-Asthma Patient Care Summary ; 23 Jun 2009 1:43 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
EN(DATA,DFN) ; EP -- BQI PATIENT ASTHMA SUMMARY
;Description
; Generates a Patient Supplement for a given DFN and Supplement
;
;Input
; DFN - Patient Internal ID
;
;Output
; DATA - Name of global in which data is stored(^TMP("BQIRPASM"))
;
NEW UID,BQII,EXEC,PRGM,%,SUPL
NEW HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N
NEW APCHSPAT,APCHSHDR,APCHSTIM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRPASM",UID))
K @DATA
;
S BQII=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRPASM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
;
I $$TMPFL^BQIUL1("W",UID,DFN) G DONE
;
S IOSL=999,IOM=80,IOST="P-OTHER80"
; APCHSPAT variable is required by APCH routines
S APCHSPAT=DFN
;
; Sometimes the header needs to be defined
S Y=DT X ^DD("DD") S APCHSDAT=Y D NOW^%DTC S X=% X ^DD("FUNC",2,1) S APCHSTIM=X
S APCHSHDR="CONFIDENTIAL PATIENT INFORMATION -- "_$$FMTE^XLFDT(DT,5)_$J(APCHSTIM,9)_" ["_$P(^VA(200,DUZ,0),U,2)_"]"
S X="",$P(X,"*",((IOM-6-$L(APCHSHDR))\2)+1)="*"
S APCHSHDR=X_" "_APCHSHDR_" "_X
;
S SUPL=$$FIND1^DIC(9001022,"","B","ASTHMA PATIENT CARE SUMMARY","","","ERROR") I 'SUPL G DONE
S EXEC=$G(^APCHSUP(SUPL,11)) I EXEC="" G DONE
S PRGM=$P(EXEC,"^",2)
I PRGM["(" S PRGM=$P(PRGM,"(",1)
I $T(@("^"_PRGM))="" G DONE
;
U IO X EXEC
U IO W $C(9)
;
I $$TMPFL^BQIUL1("C") 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)
;
I $$TMPFL^BQIUL1("C") G DONE
;
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
BQIRPASM ;VNGT/HS/ALA-Asthma Patient Care Summary ; 23 Jun 2009 1:43 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
EN(DATA,DFN) ; EP -- BQI PATIENT ASTHMA SUMMARY
+1 ;Description
+2 ; Generates a Patient Supplement for a given DFN and Supplement
+3 ;
+4 ;Input
+5 ; DFN - Patient Internal ID
+6 ;
+7 ;Output
+8 ; DATA - Name of global in which data is stored(^TMP("BQIRPASM"))
+9 ;
+10 NEW UID,BQII,EXEC,PRGM,%,SUPL
+11 NEW HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N
+12 NEW APCHSPAT,APCHSHDR,APCHSTIM
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIRPASM",UID))
+15 KILL @DATA
+16 ;
+17 SET BQII=0
+18 ;
+19 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRPASM D UNWIND^%ZTER"
+20 ;
+21 DO HDR
+22 ;
+23 IF $$TMPFL^BQIUL1("W",UID,DFN)
GOTO DONE
+24 ;
+25 SET IOSL=999
SET IOM=80
SET IOST="P-OTHER80"
+26 ; APCHSPAT variable is required by APCH routines
+27 SET APCHSPAT=DFN
+28 ;
+29 ; Sometimes the header needs to be defined
+30 SET Y=DT
XECUTE ^DD("DD")
SET APCHSDAT=Y
DO NOW^%DTC
SET X=%
XECUTE ^DD("FUNC",2,1)
SET APCHSTIM=X
+31 SET APCHSHDR="CONFIDENTIAL PATIENT INFORMATION -- "_$$FMTE^XLFDT(DT,5)_$JUSTIFY(APCHSTIM,9)_" ["_$PIECE(^VA(200,DUZ,0),U,2)_"]"
+32 SET X=""
SET $PIECE(X,"*",((IOM-6-$LENGTH(APCHSHDR))\2)+1)="*"
+33 SET APCHSHDR=X_" "_APCHSHDR_" "_X
+34 ;
+35 SET SUPL=$$FIND1^DIC(9001022,"","B","ASTHMA PATIENT CARE SUMMARY","","","ERROR")
IF 'SUPL
GOTO DONE
+36 SET EXEC=$GET(^APCHSUP(SUPL,11))
IF EXEC=""
GOTO DONE
+37 SET PRGM=$PIECE(EXEC,"^",2)
+38 IF PRGM["("
SET PRGM=$PIECE(PRGM,"(",1)
+39 IF $TEXT(@("^"_PRGM))=""
GOTO DONE
+40 ;
+41 USE IO
XECUTE EXEC
+42 USE IO
WRITE $CHAR(9)
+43 ;
+44 IF $$TMPFL^BQIUL1("C")
GOTO DONE
+45 ;
+46 IF $$TMPFL^BQIUL1("R",UID,DFN)
GOTO DONE
+47 ;
+48 FOR
USE IO
READ HSTEXT:.1
IF HSTEXT[$CHAR(9)
QUIT
Begin DoDot:1
+49 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
+50 IF HSTEXT=""
SET HSTEXT=" "
+51 SET BQII=BQII+1
SET @DATA@(BQII)=HSTEXT_$CHAR(13)_$CHAR(10)
End DoDot:1
+52 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(30)
+53 ;
+54 IF $$TMPFL^BQIUL1("C")
GOTO DONE
+55 ;
+56 IF $$TMPFL^BQIUL1("D",UID,DFN)
GOTO DONE
+57 ;
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
