WVPATP ;HCIOFO/FT,JR - PRINT WH PATIENT CASE DATA;May 30, 2018@11:49
;;1.0;WOMEN'S HEALTH;**10,14,24**;Sep 30, 1998;Build 582
;; Original routine created by IHS/ANMC/MWR
;;* 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^WVUTL5 S WVPOP=0
F D Q:$G(Y)<0
.D TITLE^WVUTL5("PRINT A PATIENT'S CASE DATA")
.D PATLKUP^WVUTL8(.Y) Q:Y<0 S WVDFN=+Y
.D DEVICE
.I WVPOP S Y=-1 Q
.D DATA(WVDFN)
D EXIT
Q
;
PRTCASE(WVDFN) ;EP
;---> PRINT CASE DATA ON ONE PATIENT.
;---> CALLED FROM ^WVPATE (EDIT PATIENT CASE DATA).
I '$G(WVDFN) D D DIRZ^WVUTL3 Q
.W !?5,"WVDFN not passed. Please contact your site manager."
D DEVICE Q:WVPOP
D DATA(WVDFN)
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^WVPATP"
F WVSV="DFN" D
.I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
D ZIS^WVUTL2(.WVPOP,1)
Q
;
DEQUEUE ;EP
;---> TASKED PRINTOUT OF PATIENT CASE DATA.
D DATA(WVDFN)
D EXIT
Q
;
DATA(WVDFN) ;EP
;---> SORT PROCEDURE TYPE FILE POINTERS.
N A,WVNODE,WVTMP,I,N
D PATVARS^WVUTL3(WVDFN)
;---> LOOP THROUGH WV PROCEDURE FILE.
S I=0
S A=WVNAMAGE
S WVNODE="Patient Name: "_A_$$S(38-$L(A))_$$PNLAB^WVUTL5()_WVCHRT
D NODE
S A=$$STREET^WVUTL1(WVDFN)
S WVNODE=$$S(6)_"Street: "_A_$$S(31-$L(A))
S WVNODE=WVNODE_"Patient Phone: "_$$HPHONE^WVUTL1(WVDFN)
D NODE
S A=$$CTYSTZ^WVUTL1(WVDFN)
S WVNODE=$$S(2)_"Cty/St/Zip: "_A_$$S(33-$L(A))
S WVNODE=WVNODE_"Pr Provider: "_$E($$PROVI^WVUTL1A(WVDFN),1,20)
D NODE
S WVNODE=" Elig Code: "_$P($$ELIG^WVUTL9(WVDFN),U,2)
S WVNODE=WVNODE_$$S(51-$L(WVNODE))_"Veteran: "_$$VET^WVUTL1A(WVDFN)
D NODE
S WVNODE=" " D NODE
S A=$E(WVCMGR,1,28)
S WVNODE=$$S(10)_"Case Manager: "_A_$$S(29-$L(A))
S WVNODE=WVNODE_"Inactive Date: "_$$SLDT2^WVUTL5($$INACT^WVUTL1(WVDFN))
D NODE
S WVNODE=$$S(8)_"Maternity Care"
D NODE
S A=$E($$MCMGR^WVUTL1(WVDFN),1,28)
S WVNODE=$$S(11)_"Coordinator: "_A
D NODE
S WVNODE=$$S(8)_"Breast Tx Need: "_WVBNEED
D NODE
S A="" I WVDFN>0 S A=$P($G(^WV(790,WVDFN,0)),U,25),A=$S(A'="":A,1:"NOT ENTERED") S:A>0 A=$$INSTTX^WVUTL6(A)
S WVNODE=$$S(7)_"Breast Facility: "_A
D NODE
S WVNODE=$$S(6)_"Cervical Tx Need: "_WVCNEED
D NODE
S A="" I WVDFN>0 S A=$P($G(^WV(790,WVDFN,0)),U,26) S A=$S(A'="":A,1:"NOT ENTERED") S:A>0 A=$$INSTTX^WVUTL6(A)
S WVNODE=$$S(5)_"Cervical Facility: "_A
D NODE
S WVNODE=$$S(11)_"PAP Regimen: "_WVPAPRG
D NODE S WVNODE=" " D NODE
S WVNODE=$$S(0)_"Family Hx of Breast CA: "_$$FAMHX^WVUTL1(WVDFN)
D NODE
S A=$$EDC^WVUTL1(WVDFN,1)
S WVNODE=$$S(4)_"Currently Pregnant: "_A_$$S(32-$L(A))
S WVNODE=WVNODE_"DES Daughter: "_$$DES^WVUTL1(WVDFN)
D NODE
S A=$$MST^WVUTL1A(WVDFN)
S WVNODE=$$S(19)_"MST: "_A
D NODE
S A=$$CST^WVUTL1A(WVDFN)
S WVNODE=$$S(19)_"CST: "_A
D NODE
S A=$$ENRLDT^WVUTL1(WVDFN)
S WVNODE=$$S(1)_"Date of 1st Encounter: "_A_$$S(29-$L(A))
S WVNODE=WVNODE_"Referral Source: "_$$REFS^WVUTL1(WVDFN)
D NODE S WVNODE=" " D NODE
S WVNODE=$$S(25)_"---- Text of NOTES ----"
D NODE S WVNODE=" " D NODE
S N=0
F S N=$O(^WV(790,WVDFN,1,N)) Q:'N D
.S WVNODE=^WV(790,WVDFN,1,N,0) D NODE
S WVNODE=" " D NODE
S WVNODE=$$S(20)_"----- End of Patient Printout -----" D NODE
D DISPLAY
Q
;
NODE ;EP
;---> SET NODE.
S I=I+1,WVTMP("WV",$J,I,0)=WVNODE
Q
;
S(S) ;EP
;---> SPACES.
Q $$S^WVUTL7($G(S))
;
DISPLAY ;EP
U IO
D TOPHEAD^WVUTL7
S WVTITLE1="* * * WOMEN'S HEALTH: PATIENT CASE DATA PRINTOUT * * *"
D CENTERT^WVUTL5(.WVTITLE1)
;
S (WVPOP,N,Z)=0
W:WVCRT @IOF D HEADER
F S N=$O(WVTMP("WV",$J,N)) Q:'N!(WVPOP) D
.I $Y+5>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
.W !,WVTMP("WV",$J,N,0)
I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
D ^%ZISC
K WVTMP("WV",$J)
Q
;
W:WVPAGE>1!WVCRT @IOF,!
W WVCONFF W:'WVCRT !,WVTIMLN
W !!,WVTITLE1,?70,"page: ",WVPAGE
W !,$$RUNDT^WVUTL1A("C")
W !,WVLINE S WVPAGE=WVPAGE+1
;W !!,"Patient Name: ",WVNAMAGE,?53,$$PNLAB^WVUTL5(),WVCHRT
Q
;
EXIT ;EP
D KILLALL^WVUTL8
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVPATP 4190 printed Oct 16, 2024@18:47:50 Page 2
WVPATP ;HCIOFO/FT,JR - PRINT WH PATIENT CASE DATA;May 30, 2018@11:49
+1 ;;1.0;WOMEN'S HEALTH;**10,14,24**;Sep 30, 1998;Build 582
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; PRINT A PATIENT'S CASE DATA.
+5 ;
BEGIN ;EP
+1 ;---> LOOP TO PRINT PATIENTS' CASE DATA.
+2 ;---> NOT CURRENTLY CALLED BY ANY OPTION.
+3 DO SETVARS^WVUTL5
SET WVPOP=0
+4 FOR
Begin DoDot:1
+5 DO TITLE^WVUTL5("PRINT A PATIENT'S CASE DATA")
+6 DO PATLKUP^WVUTL8(.Y)
if Y<0
QUIT
SET WVDFN=+Y
+7 DO DEVICE
+8 IF WVPOP
SET Y=-1
QUIT
+9 DO DATA(WVDFN)
End DoDot:1
if $GET(Y)<0
QUIT
+10 DO EXIT
+11 QUIT
+12 ;
PRTCASE(WVDFN) ;EP
+1 ;---> PRINT CASE DATA ON ONE PATIENT.
+2 ;---> CALLED FROM ^WVPATE (EDIT PATIENT CASE DATA).
+3 IF '$GET(WVDFN)
Begin DoDot:1
+4 WRITE !?5,"WVDFN not passed. Please contact your site manager."
End DoDot:1
DO DIRZ^WVUTL3
QUIT
+5 DO DEVICE
if WVPOP
QUIT
+6 DO DATA(WVDFN)
+7 QUIT
+8 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^WVPATP"
+3 FOR WVSV="DFN"
Begin DoDot:1
+4 IF $DATA(@("WV"_WVSV))
SET ZTSAVE("WV"_WVSV)=""
End DoDot:1
+5 DO ZIS^WVUTL2(.WVPOP,1)
+6 QUIT
+7 ;
DEQUEUE ;EP
+1 ;---> TASKED PRINTOUT OF PATIENT CASE DATA.
+2 DO DATA(WVDFN)
+3 DO EXIT
+4 QUIT
+5 ;
DATA(WVDFN) ;EP
+1 ;---> SORT PROCEDURE TYPE FILE POINTERS.
+2 NEW A,WVNODE,WVTMP,I,N
+3 DO PATVARS^WVUTL3(WVDFN)
+4 ;---> LOOP THROUGH WV PROCEDURE FILE.
+5 SET I=0
+6 SET A=WVNAMAGE
+7 SET WVNODE="Patient Name: "_A_$$S(38-$LENGTH(A))_$$PNLAB^WVUTL5()_WVCHRT
+8 DO NODE
+9 SET A=$$STREET^WVUTL1(WVDFN)
+10 SET WVNODE=$$S(6)_"Street: "_A_$$S(31-$LENGTH(A))
+11 SET WVNODE=WVNODE_"Patient Phone: "_$$HPHONE^WVUTL1(WVDFN)
+12 DO NODE
+13 SET A=$$CTYSTZ^WVUTL1(WVDFN)
+14 SET WVNODE=$$S(2)_"Cty/St/Zip: "_A_$$S(33-$LENGTH(A))
+15 SET WVNODE=WVNODE_"Pr Provider: "_$EXTRACT($$PROVI^WVUTL1A(WVDFN),1,20)
+16 DO NODE
+17 SET WVNODE=" Elig Code: "_$PIECE($$ELIG^WVUTL9(WVDFN),U,2)
+18 SET WVNODE=WVNODE_$$S(51-$LENGTH(WVNODE))_"Veteran: "_$$VET^WVUTL1A(WVDFN)
+19 DO NODE
+20 SET WVNODE=" "
DO NODE
+21 SET A=$EXTRACT(WVCMGR,1,28)
+22 SET WVNODE=$$S(10)_"Case Manager: "_A_$$S(29-$LENGTH(A))
+23 SET WVNODE=WVNODE_"Inactive Date: "_$$SLDT2^WVUTL5($$INACT^WVUTL1(WVDFN))
+24 DO NODE
+25 SET WVNODE=$$S(8)_"Maternity Care"
+26 DO NODE
+27 SET A=$EXTRACT($$MCMGR^WVUTL1(WVDFN),1,28)
+28 SET WVNODE=$$S(11)_"Coordinator: "_A
+29 DO NODE
+30 SET WVNODE=$$S(8)_"Breast Tx Need: "_WVBNEED
+31 DO NODE
+32 SET A=""
IF WVDFN>0
SET A=$PIECE($GET(^WV(790,WVDFN,0)),U,25)
SET A=$SELECT(A'="":A,1:"NOT ENTERED")
if A>0
SET A=$$INSTTX^WVUTL6(A)
+33 SET WVNODE=$$S(7)_"Breast Facility: "_A
+34 DO NODE
+35 SET WVNODE=$$S(6)_"Cervical Tx Need: "_WVCNEED
+36 DO NODE
+37 SET A=""
IF WVDFN>0
SET A=$PIECE($GET(^WV(790,WVDFN,0)),U,26)
SET A=$SELECT(A'="":A,1:"NOT ENTERED")
if A>0
SET A=$$INSTTX^WVUTL6(A)
+38 SET WVNODE=$$S(5)_"Cervical Facility: "_A
+39 DO NODE
+40 SET WVNODE=$$S(11)_"PAP Regimen: "_WVPAPRG
+41 DO NODE
SET WVNODE=" "
DO NODE
+42 SET WVNODE=$$S(0)_"Family Hx of Breast CA: "_$$FAMHX^WVUTL1(WVDFN)
+43 DO NODE
+44 SET A=$$EDC^WVUTL1(WVDFN,1)
+45 SET WVNODE=$$S(4)_"Currently Pregnant: "_A_$$S(32-$LENGTH(A))
+46 SET WVNODE=WVNODE_"DES Daughter: "_$$DES^WVUTL1(WVDFN)
+47 DO NODE
+48 SET A=$$MST^WVUTL1A(WVDFN)
+49 SET WVNODE=$$S(19)_"MST: "_A
+50 DO NODE
+51 SET A=$$CST^WVUTL1A(WVDFN)
+52 SET WVNODE=$$S(19)_"CST: "_A
+53 DO NODE
+54 SET A=$$ENRLDT^WVUTL1(WVDFN)
+55 SET WVNODE=$$S(1)_"Date of 1st Encounter: "_A_$$S(29-$LENGTH(A))
+56 SET WVNODE=WVNODE_"Referral Source: "_$$REFS^WVUTL1(WVDFN)
+57 DO NODE
SET WVNODE=" "
DO NODE
+58 SET WVNODE=$$S(25)_"---- Text of NOTES ----"
+59 DO NODE
SET WVNODE=" "
DO NODE
+60 SET N=0
+61 FOR
SET N=$ORDER(^WV(790,WVDFN,1,N))
if 'N
QUIT
Begin DoDot:1
+62 SET WVNODE=^WV(790,WVDFN,1,N,0)
DO NODE
End DoDot:1
+63 SET WVNODE=" "
DO NODE
+64 SET WVNODE=$$S(20)_"----- End of Patient Printout -----"
DO NODE
+65 DO DISPLAY
+66 QUIT
+67 ;
NODE ;EP
+1 ;---> SET NODE.
+2 SET I=I+1
SET WVTMP("WV",$JOB,I,0)=WVNODE
+3 QUIT
+4 ;
S(S) ;EP
+1 ;---> SPACES.
+2 QUIT $$S^WVUTL7($GET(S))
+3 ;
DISPLAY ;EP
+1 USE IO
+2 DO TOPHEAD^WVUTL7
+3 SET WVTITLE1="* * * WOMEN'S HEALTH: PATIENT CASE DATA PRINTOUT * * *"
+4 DO CENTERT^WVUTL5(.WVTITLE1)
+5 ;
+6 SET (WVPOP,N,Z)=0
+7 if WVCRT
WRITE @IOF
DO HEADER
+8 FOR
SET N=$ORDER(WVTMP("WV",$JOB,N))
if 'N!(WVPOP)
QUIT
Begin DoDot:1
+9 IF $Y+5>IOSL
if WVCRT
DO DIRZ^WVUTL3
if WVPOP
QUIT
DO HEADER
+10 WRITE !,WVTMP("WV",$JOB,N,0)
End DoDot:1
+11 IF WVCRT&('WVPOP)
WRITE !!
DO DIRZ^WVUTL3
+12 DO ^%ZISC
+13 KILL WVTMP("WV",$JOB)
+14 QUIT
+15 ;
+1 if WVPAGE>1!WVCRT
WRITE @IOF,!
+2 WRITE WVCONFF
if 'WVCRT
WRITE !,WVTIMLN
+3 WRITE !!,WVTITLE1,?70,"page: ",WVPAGE
+4 WRITE !,$$RUNDT^WVUTL1A("C")
+5 WRITE !,WVLINE
SET WVPAGE=WVPAGE+1
+6 ;W !!,"Patient Name: ",WVNAMAGE,?53,$$PNLAB^WVUTL5(),WVCHRT
+7 QUIT
+8 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
