BQIWHPRF ;VNGT/HS/ALA-Women's Health Brief Profile ; 29 Apr 2010 5:38 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,DFN) ; EP -- BQI WOMENS HEALTH PROFILE
;Description
; Generates a Brief Women's Health Profile
;
;Input
; DFN - Patient Internal ID
;
NEW UID,X,BQII,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,BWACC,BWACCP,BWBNEED,BWCHRT,I
NEW BWCMGR,BWCNEED,BWCRT,BWD,BWDATE,BWDATE1,BWDFN,BWDIAG,BWEDC,BWERRORS,BWIEN,M
NEW BWNAMAGE,BWNAME,BWPAGE,BWPAPRG,BWPCD,BWPOP,BWPROV,BWSTAT,BWSUBH,BWTAB,BWTITLE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIWHPRF",UID))
K @DATA
;
S BQII=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIWHPRF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S IOSL=999,IOM=80,IOST="P-OTHER80"
S IOST(0)=$$FIND1^DIC(3.2,,"X",IOST)
;
I $P($G(^DPT(DFN,0)),U,2)'="F" D Q
. S @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
. S BQII=BQII+1,@DATA@(BQII)="-1^RPC Failed: Patient is not Female"_$C(30)
. S BQII=BQII+1,@DATA@(BQII)=$C(31)
I $G(^BWP(DFN,0))="" D Q
. S @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$C(30)
. S BQII=BQII+1,@DATA@(BQII)="-1^RPC Failed: Patient is not in the Women's Health file"_$C(30)
. S BQII=BQII+1,@DATA@(BQII)=$C(31)
;
D HDR
;
I $$TMPFL^BQIUL1("W",UID,DFN) G DONE
;
S BWDFN=DFN
S BWERRORS=0,BWD=0,BWPAGE=0,BWCRT=1,BWTAB=5
S BWTITLE="* * * WOMEN'S HEALTH: PATIENT PROFILE * * *"
D SORT^BWPROF2
D COPYGBL^BWPROF
S N=0,BWPOP=0
U IO D DISPLAY
U IO W $C(9)
D DISPLAY
;
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)="T01024REPORT_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
;
DISPLAY ; Copied and modified from BWPROF3
S BWSUBH="SUBHEAD^BWPROF1"
D HEADER2^BWUTL7
S N=0
F S N=$O(^TMP("BW",$J,2,N)) Q:'N!(BWPOP) D
.S Y=^TMP("BW",$J,2,N),M=N
.;---> QUIT IF NOT A PROCEDURE (PIECE 1'=1).
.Q:$P(Y,U)'=1
.W ! W:BWCRT $J(N,3),")" W ?BWTAB ;BROWSE SELECTION#
.W $P(Y,U,4) ;DATE OF PROCEDURE
.W ?17,$P(Y,U,5) ;PROCEDURE ABBREVIATION
.W ?27,$P(Y,U,7) ;RESULT
.W ?71,$P(Y,U,9) ;STATUS
.S BWACCP=$P(Y,U,6) ;STORE AS PREVIOUS ACCESS#
END2 ;EP
;W:'BWCRT @IOF
;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-1 AND START (GOTO)
;---> DISPLAY2 OVER AGAIN FROM 5 RECORDS PREVIOUS.
;I BWCRT&('$D(IO("S")))&('BWPOP) D DIRPRMT^BWUTL3 I N S N=N-1 G NOMATCH
;D ^%ZISC:'$G(BWEXT) ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
K N,Z
Q
BQIWHPRF ;VNGT/HS/ALA-Women's Health Brief Profile ; 29 Apr 2010 5:38 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN) ; EP -- BQI WOMENS HEALTH PROFILE
+1 ;Description
+2 ; Generates a Brief Women's Health Profile
+3 ;
+4 ;Input
+5 ; DFN - Patient Internal ID
+6 ;
+7 NEW UID,X,BQII,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,BWACC,BWACCP,BWBNEED,BWCHRT,I
+8 NEW BWCMGR,BWCNEED,BWCRT,BWD,BWDATE,BWDATE1,BWDFN,BWDIAG,BWEDC,BWERRORS,BWIEN,M
+9 NEW BWNAMAGE,BWNAME,BWPAGE,BWPAPRG,BWPCD,BWPOP,BWPROV,BWSTAT,BWSUBH,BWTAB,BWTITLE
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BQIWHPRF",UID))
+12 KILL @DATA
+13 ;
+14 SET BQII=0
+15 ;
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIWHPRF D UNWIND^%ZTER"
+17 ;
+18 SET IOSL=999
SET IOM=80
SET IOST="P-OTHER80"
+19 SET IOST(0)=$$FIND1^DIC(3.2,,"X",IOST)
+20 ;
+21 IF $PIECE($GET(^DPT(DFN,0)),U,2)'="F"
Begin DoDot:1
+22 SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+23 SET BQII=BQII+1
SET @DATA@(BQII)="-1^RPC Failed: Patient is not Female"_$CHAR(30)
+24 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
End DoDot:1
QUIT
+25 IF $GET(^BWP(DFN,0))=""
Begin DoDot:1
+26 SET @DATA@(BQII)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+27 SET BQII=BQII+1
SET @DATA@(BQII)="-1^RPC Failed: Patient is not in the Women's Health file"_$CHAR(30)
+28 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
End DoDot:1
QUIT
+29 ;
+30 DO HDR
+31 ;
+32 IF $$TMPFL^BQIUL1("W",UID,DFN)
GOTO DONE
+33 ;
+34 SET BWDFN=DFN
+35 SET BWERRORS=0
SET BWD=0
SET BWPAGE=0
SET BWCRT=1
SET BWTAB=5
+36 SET BWTITLE="* * * WOMEN'S HEALTH: PATIENT PROFILE * * *"
+37 DO SORT^BWPROF2
+38 DO COPYGBL^BWPROF
+39 SET N=0
SET BWPOP=0
+40 USE IO
DO DISPLAY
+41 USE IO
WRITE $CHAR(9)
+42 DO DISPLAY
+43 ;
+44 IF $$TMPFL^BQIUL1("C")
GOTO DONE
+45 IF $$TMPFL^BQIUL1("R",UID,DFN)
GOTO DONE
+46 ;
+47 FOR
USE IO
READ HSTEXT:.1
IF HSTEXT[$CHAR(9)
QUIT
Begin DoDot:1
+48 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
+49 IF HSTEXT=""
SET HSTEXT=" "
+50 SET BQII=BQII+1
SET @DATA@(BQII)=HSTEXT_$CHAR(13)_$CHAR(10)
End DoDot:1
+51 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(30)
+52 ;
+53 IF $$TMPFL^BQIUL1("C")
GOTO DONE
+54 IF $$TMPFL^BQIUL1("D",UID,DFN)
GOTO DONE
+55 ;
DONE ;
+1 ;
+2 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+3 QUIT
+4 ;
HDR ;
+1 SET @DATA@(BQII)="T01024REPORT_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
+8 ;
DISPLAY ; Copied and modified from BWPROF3
+1 SET BWSUBH="SUBHEAD^BWPROF1"
+2 DO HEADER2^BWUTL7
+3 SET N=0
+4 FOR
SET N=$ORDER(^TMP("BW",$JOB,2,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+5 SET Y=^TMP("BW",$JOB,2,N)
SET M=N
+6 ;---> QUIT IF NOT A PROCEDURE (PIECE 1'=1).
+7 IF $PIECE(Y,U)'=1
QUIT
+8 ;BROWSE SELECTION#
WRITE !
IF BWCRT
WRITE $JUSTIFY(N,3),")"
WRITE ?BWTAB
+9 ;DATE OF PROCEDURE
WRITE $PIECE(Y,U,4)
+10 ;PROCEDURE ABBREVIATION
WRITE ?17,$PIECE(Y,U,5)
+11 ;RESULT
WRITE ?27,$PIECE(Y,U,7)
+12 ;STATUS
WRITE ?71,$PIECE(Y,U,9)
+13 ;STORE AS PREVIOUS ACCESS#
SET BWACCP=$PIECE(Y,U,6)
End DoDot:1
END2 ;EP
+1 ;W:'BWCRT @IOF
+2 ;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-1 AND START (GOTO)
+3 ;---> DISPLAY2 OVER AGAIN FROM 5 RECORDS PREVIOUS.
+4 ;I BWCRT&('$D(IO("S")))&('BWPOP) D DIRPRMT^BWUTL3 I N S N=N-1 G NOMATCH
+5 ;D ^%ZISC:'$G(BWEXT) ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
+6 KILL N,Z
+7 QUIT
