BWPATP ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK;11-Feb-2003 12:43;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; PRINT A PATIENT'S CASE DATA.
;
BEGIN ;EP
;---> LOOP TO PRINT PATIENTS' CASE DATA.
;---> NOT CURRENTLY CALLED BY ANY OPTION.
D SETVARS^BWUTL5 S BWPOP=0
F D Q:$G(Y)<0
.D TITLE^BWUTL5("PRINT A PATIENT'S CASE DATA")
.D PATLKUP^BWUTL8(.Y) Q:Y<0 S BWDFN=+Y
.D DEVICE
.I BWPOP S Y=-1 Q
.D DATA(BWDFN)
D EXIT
Q
;
PRTCASE(BWDFN) ;EP
;---> PRINT CASE DATA ON ONE PATIENT.
;---> CALLED FROM ^BWPATE (EDIT PATIENT CASE DATA).
I '$G(BWDFN) D D DIRZ^BWUTL3 Q
.W !?5,"BWDFN not passed. Please contact your site manager."
D DEVICE Q:BWPOP
D DATA(BWDFN)
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^BWPATP"
F BWSV="DFN" D
.I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""
D ZIS^BWUTL2(.BWPOP,1)
Q
;
DEQUEUE ;EP
;---> TASKED PRINTOUT OF PATIENT CASE DATA.
D DATA(BWDFN)
D EXIT
Q
;
DATA(BWDFN) ;EP
;---> SORT PROCEDURE TYPE FILE POINTERS.
N A,BWNODE,BWTMP,I,J,N
D PATVARS^BWUTL3(BWDFN)
;---> LOOP THROUGH BW PROCEDURE FILE.
S I=0
S A=BWNAMAGE
S BWNODE="Patient Name: "_A_$$S(42-$L(A))_$$PNLAB^BWUTL5(DUZ(2))_BWCHRT
D NODE
S A=$$STREET^BWUTL1(BWDFN)
S BWNODE=$$S(6)_"Street: "_A_$$S(35-$L(A))
S BWNODE=BWNODE_"Patient Phone: "_$$HPHONE^BWUTL1(BWDFN)
D NODE
S A=$$CTYSTZ^BWUTL1(BWDFN)
S BWNODE=$$S(2)_"Cty/St/Zip: "_A_$$S(39-$L(A))
S BWNODE=BWNODE_"Unique ID: "_$$CDCID^BWUTL1(BWDFN)
D NODE S BWNODE=" " D NODE
S A=$E(BWCMGR,1,28)
S BWNODE=$$S(10)_"Case Manager: "_A_$$S(29-$L(A))
S BWNODE=BWNODE_"Inactive Date: "_$$SLDT2^BWUTL5($$INACT^BWUTL1(BWDFN))
D NODE
S BWNODE=$$S(8)_"Breast Tx Need: "_BWBNEED
D NODE
S BWNODE=$$S(6)_"Cervical Tx Need: "_BWCNEED
D NODE
S BWNODE=$$S(11)_"PAP Regimen: "_BWPAPRG
D NODE S BWNODE=" " D NODE
S BWNODE=$$S(0)_"Family Hx of Breast CA: "_$$FAMHX^BWUTL1(BWDFN)
D NODE
S A=$$EDC^BWUTL1(BWDFN)
S BWNODE=$$S(3)_"Currently Pregnant: "_A_$$S(32-$L(A))
S BWNODE=BWNODE_"DES Daughter: "_$$DES^BWUTL1(BWDFN)
D NODE
S A=$$ENRLDT^BWUTL1(BWDFN)
S BWNODE=$$S(9)_"Date Enrolled: "_A_$$S(29-$L(A))
S BWNODE=BWNODE_"Referral Source: "_$$REFS^BWUTL1(BWDFN)
D NODE S BWNODE=" " D NODE
S J=0
F S J=$O(^BWP(BWDFN,2,J)) Q:'J D
. S BWNODE=$$RJ^XLFSTR("Race "_J_": ",23)_$$GET1^DIQ(9002086.07,J_","_BWDFN_",",.01)
. D NODE
S BWNODE=$$RJ^XLFSTR("Income Eligible: ",23)_$$GET1^DIQ(9002086,BWDFN_",",.29)
S BWNODE=BWNODE_$$RJ^XLFSTR("Income Eligible Date: ",70-$L(BWNODE))_$$GET1^DIQ(9002086,BWDFN_",",.3)
D NODE
S BWNODE=" " D NODE
S BWNODE=$$S(25)_"---- Text of NOTES ----"
D NODE S BWNODE=" " D NODE
S N=0
F S N=$O(^BWP(BWDFN,1,N)) Q:'N D
.S BWNODE=^BWP(BWDFN,1,N,0) D NODE
S BWNODE=" " D NODE
S BWNODE=$$S(20)_"----- End of Patient Printout -----" D NODE
D DISPLAY
Q
;
NODE ;EP
;---> SET NODE.
S I=I+1,BWTMP("BW",$J,I,0)=BWNODE
Q
;
S(S) ;EP
;---> SPACES.
Q $$S^BWUTL7($G(S))
;
DISPLAY ;EP
U IO
D TOPHEAD^BWUTL7
S BWTITLE1="* * * WOMEN'S HEALTH: PATIENT CASE DATA PRINTOUT * * *"
D CENTERT^BWUTL5(.BWTITLE1)
;
S (BWPOP,N,Z)=0
W:BWCRT @IOF D HEADER
F S N=$O(BWTMP("BW",$J,N)) Q:'N!(BWPOP) D
.I $Y+8>IOSL D:BWCRT DIRZ^BWUTL3 Q:BWPOP D HEADER
.W !,BWTMP("BW",$J,N,0)
I BWCRT&('BWPOP) W !! D DIRZ^BWUTL3
W:'BWCRT @IOF
D ^%ZISC
K BWTMP("BW",$J)
Q
;
W:BWPAGE>1!BWCRT @IOF,!
W BWCONFF W:'BWCRT !,BWTIMLN
W !!,BWTITLE1,?70,"page: ",BWPAGE,!,BWLINE S BWPAGE=BWPAGE+1
;W !!,"Patient Name: ",BWNAMAGE,?53,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
Q
;
EXIT ;EP
D KILLALL^BWUTL8
Q
BWPATP ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK;11-Feb-2003 12:43;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; PRINT A PATIENT'S CASE DATA.
+4 ;
BEGIN ;EP
+1 ;---> LOOP TO PRINT PATIENTS' CASE DATA.
+2 ;---> NOT CURRENTLY CALLED BY ANY OPTION.
+3 DO SETVARS^BWUTL5
SET BWPOP=0
+4 FOR
Begin DoDot:1
+5 DO TITLE^BWUTL5("PRINT A PATIENT'S CASE DATA")
+6 DO PATLKUP^BWUTL8(.Y)
IF Y<0
QUIT
SET BWDFN=+Y
+7 DO DEVICE
+8 IF BWPOP
SET Y=-1
QUIT
+9 DO DATA(BWDFN)
End DoDot:1
IF $GET(Y)<0
QUIT
+10 DO EXIT
+11 QUIT
+12 ;
PRTCASE(BWDFN) ;EP
+1 ;---> PRINT CASE DATA ON ONE PATIENT.
+2 ;---> CALLED FROM ^BWPATE (EDIT PATIENT CASE DATA).
+3 IF '$GET(BWDFN)
Begin DoDot:1
+4 WRITE !?5,"BWDFN not passed. Please contact your site manager."
End DoDot:1
DO DIRZ^BWUTL3
QUIT
+5 DO DEVICE
IF BWPOP
QUIT
+6 DO DATA(BWDFN)
+7 QUIT
+8 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^BWPATP"
+3 FOR BWSV="DFN"
Begin DoDot:1
+4 IF $DATA(@("BW"_BWSV))
SET ZTSAVE("BW"_BWSV)=""
End DoDot:1
+5 DO ZIS^BWUTL2(.BWPOP,1)
+6 QUIT
+7 ;
DEQUEUE ;EP
+1 ;---> TASKED PRINTOUT OF PATIENT CASE DATA.
+2 DO DATA(BWDFN)
+3 DO EXIT
+4 QUIT
+5 ;
DATA(BWDFN) ;EP
+1 ;---> SORT PROCEDURE TYPE FILE POINTERS.
+2 NEW A,BWNODE,BWTMP,I,J,N
+3 DO PATVARS^BWUTL3(BWDFN)
+4 ;---> LOOP THROUGH BW PROCEDURE FILE.
+5 SET I=0
+6 SET A=BWNAMAGE
+7 SET BWNODE="Patient Name: "_A_$$S(42-$LENGTH(A))_$$PNLAB^BWUTL5(DUZ(2))_BWCHRT
+8 DO NODE
+9 SET A=$$STREET^BWUTL1(BWDFN)
+10 SET BWNODE=$$S(6)_"Street: "_A_$$S(35-$LENGTH(A))
+11 SET BWNODE=BWNODE_"Patient Phone: "_$$HPHONE^BWUTL1(BWDFN)
+12 DO NODE
+13 SET A=$$CTYSTZ^BWUTL1(BWDFN)
+14 SET BWNODE=$$S(2)_"Cty/St/Zip: "_A_$$S(39-$LENGTH(A))
+15 SET BWNODE=BWNODE_"Unique ID: "_$$CDCID^BWUTL1(BWDFN)
+16 DO NODE
SET BWNODE=" "
DO NODE
+17 SET A=$EXTRACT(BWCMGR,1,28)
+18 SET BWNODE=$$S(10)_"Case Manager: "_A_$$S(29-$LENGTH(A))
+19 SET BWNODE=BWNODE_"Inactive Date: "_$$SLDT2^BWUTL5($$INACT^BWUTL1(BWDFN))
+20 DO NODE
+21 SET BWNODE=$$S(8)_"Breast Tx Need: "_BWBNEED
+22 DO NODE
+23 SET BWNODE=$$S(6)_"Cervical Tx Need: "_BWCNEED
+24 DO NODE
+25 SET BWNODE=$$S(11)_"PAP Regimen: "_BWPAPRG
+26 DO NODE
SET BWNODE=" "
DO NODE
+27 SET BWNODE=$$S(0)_"Family Hx of Breast CA: "_$$FAMHX^BWUTL1(BWDFN)
+28 DO NODE
+29 SET A=$$EDC^BWUTL1(BWDFN)
+30 SET BWNODE=$$S(3)_"Currently Pregnant: "_A_$$S(32-$LENGTH(A))
+31 SET BWNODE=BWNODE_"DES Daughter: "_$$DES^BWUTL1(BWDFN)
+32 DO NODE
+33 SET A=$$ENRLDT^BWUTL1(BWDFN)
+34 SET BWNODE=$$S(9)_"Date Enrolled: "_A_$$S(29-$LENGTH(A))
+35 SET BWNODE=BWNODE_"Referral Source: "_$$REFS^BWUTL1(BWDFN)
+36 DO NODE
SET BWNODE=" "
DO NODE
+37 SET J=0
+38 FOR
SET J=$ORDER(^BWP(BWDFN,2,J))
IF 'J
QUIT
Begin DoDot:1
+39 SET BWNODE=$$RJ^XLFSTR("Race "_J_": ",23)_$$GET1^DIQ(9002086.07,J_","_BWDFN_",",.01)
+40 DO NODE
End DoDot:1
+41 SET BWNODE=$$RJ^XLFSTR("Income Eligible: ",23)_$$GET1^DIQ(9002086,BWDFN_",",.29)
+42 SET BWNODE=BWNODE_$$RJ^XLFSTR("Income Eligible Date: ",70-$LENGTH(BWNODE))_$$GET1^DIQ(9002086,BWDFN_",",.3)
+43 DO NODE
+44 SET BWNODE=" "
DO NODE
+45 SET BWNODE=$$S(25)_"---- Text of NOTES ----"
+46 DO NODE
SET BWNODE=" "
DO NODE
+47 SET N=0
+48 FOR
SET N=$ORDER(^BWP(BWDFN,1,N))
IF 'N
QUIT
Begin DoDot:1
+49 SET BWNODE=^BWP(BWDFN,1,N,0)
DO NODE
End DoDot:1
+50 SET BWNODE=" "
DO NODE
+51 SET BWNODE=$$S(20)_"----- End of Patient Printout -----"
DO NODE
+52 DO DISPLAY
+53 QUIT
+54 ;
NODE ;EP
+1 ;---> SET NODE.
+2 SET I=I+1
SET BWTMP("BW",$JOB,I,0)=BWNODE
+3 QUIT
+4 ;
S(S) ;EP
+1 ;---> SPACES.
+2 QUIT $$S^BWUTL7($GET(S))
+3 ;
DISPLAY ;EP
+1 USE IO
+2 DO TOPHEAD^BWUTL7
+3 SET BWTITLE1="* * * WOMEN'S HEALTH: PATIENT CASE DATA PRINTOUT * * *"
+4 DO CENTERT^BWUTL5(.BWTITLE1)
+5 ;
+6 SET (BWPOP,N,Z)=0
+7 IF BWCRT
WRITE @IOF
DO HEADER
+8 FOR
SET N=$ORDER(BWTMP("BW",$JOB,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+9 IF $Y+8>IOSL
IF BWCRT
DO DIRZ^BWUTL3
IF BWPOP
QUIT
DO HEADER
+10 WRITE !,BWTMP("BW",$JOB,N,0)
End DoDot:1
+11 IF BWCRT&('BWPOP)
WRITE !!
DO DIRZ^BWUTL3
+12 IF 'BWCRT
WRITE @IOF
+13 DO ^%ZISC
+14 KILL BWTMP("BW",$JOB)
+15 QUIT
+16 ;
+1 IF BWPAGE>1!BWCRT
WRITE @IOF,!
+2 WRITE BWCONFF
IF 'BWCRT
WRITE !,BWTIMLN
+3 WRITE !!,BWTITLE1,?70,"page: ",BWPAGE,!,BWLINE
SET BWPAGE=BWPAGE+1
+4 ;W !!,"Patient Name: ",BWNAMAGE,?53,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
+5 QUIT
+6 ;
EXIT ;EP
+1 DO KILLALL^BWUTL8
+2 QUIT
