VistA-FOIAVistA/r/WOMENS_HEALTH-WV/WVPATP.m

144 lines
3.9 KiB
Mathematica

WVPATP ;HCIOFO/FT,JR-Print WH Patient Case Data ;4/2/01 09:24
;;1.0;WOMEN'S HEALTH;**10,14**;Sep 30, 1998
;; 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)_"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)
I A="",$P(^WV(790,WVDFN,0),U,13)=0 S A="NO"
S WVNODE=$$S(3)_"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
;
HEADER ;EP
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