121 lines
3.2 KiB
Mathematica
121 lines
3.2 KiB
Mathematica
WVPROF ;HCIOFO/FT,JR IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; ;7/30/98 11:38
|
|
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; CALL ED BY OPTION: "WV PATIENT PROFILE" TO DISPLAY PROFILE.
|
|
;
|
|
;---> *NOTE: TO ASK DATE RANGE, UNCOMMENT ALL LINES WITH "XDATES",
|
|
;---> AND IN HEADER2^WVUTL7.
|
|
;
|
|
;---> VARIABLES:
|
|
;---> WVDFN: DFN OF SELECTED PATIENT
|
|
;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
|
|
;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
|
|
;
|
|
D SETVARS^WVUTL5
|
|
S:'$D(WVERRORS) WVERRORS=1
|
|
F D RUN Q:WVPOP
|
|
D EXIT
|
|
Q
|
|
;
|
|
RUN ;EP
|
|
D TITLE^WVUTL5("PATIENT PROFILE")
|
|
D PATIENT Q:WVPOP
|
|
D BRIEF Q:WVPOP
|
|
D DEVICE Q:WVPOP
|
|
D SORT^WVPROF2
|
|
D COPYGBL
|
|
D ^WVPROF1 S WVPOP=0
|
|
K WVD,WVSUBH
|
|
Q
|
|
;
|
|
EXIT ;EP
|
|
D KILLALL^WVUTL8
|
|
Q
|
|
;
|
|
;
|
|
PATIENT ;EP
|
|
;---> SELECT PATIENT (RETURN WVDFN).
|
|
W !!," Select the patient whose Profile you wish to display."
|
|
D PATLKUP^WVUTL8(.Y) S:Y<0 WVPOP=1
|
|
;---> USE NEXT LINE IF I WANT TO ADD CAPABILITY OF ADDING NEW PATIENT.
|
|
;D PATLKUP^WVUTL8(.Y,$S($G(WVPUSER):"",1:"ADD")) S:Y<0 WVPOP=1
|
|
S WVDFN=+Y
|
|
Q
|
|
;
|
|
DATES ;EP
|
|
;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
|
|
;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-5YEARS.
|
|
;S WVBEGDT=2500101,WVENDDT=DT ;---> XDATES-CAN USE THIS INSTEAD.
|
|
;S WVBEGDF="T-60M",WVENDDF="T" ;---> XDATES
|
|
;D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-365","T") ;---> XDATES
|
|
Q
|
|
;
|
|
BRIEF ;EP
|
|
;---> BRIEF OR DETAILED LISTING OF PROCEDURES (BRIEF DOES NOT LIST
|
|
;---> NOTIFICATIONS AND PROVIDERS).
|
|
N DIR,DIRUT,Y
|
|
W !!?3,"List Patient Profile in BRIEF or DETAILED format?"
|
|
S DIR("A")=" Select BRIEF or DETAILED: ",DIR("B")="BRIEF"
|
|
S DIR(0)="SAM^b:BRIEF;d:DETAILED" D HELP1
|
|
D ^DIR
|
|
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
|
|
;---> IF ALL DETAILED, S WVD=1; FOR BRIEF WVD=0
|
|
S WVD=$S(Y="d":1,1:0)
|
|
Q
|
|
;
|
|
DEVICE ;EP
|
|
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
|
S ZTRTN="DEQUEUE^WVPROF"
|
|
F WVSV="D","DFN","BEGDT","ENDDT","ERRORS" D
|
|
.I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
|
|
D ZIS^WVUTL2(.WVPOP,1,"HOME")
|
|
Q
|
|
;
|
|
COPYGBL ;EP
|
|
;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
|
|
N I,M,N,P,Q
|
|
S N=0,I=0
|
|
F S N=$O(^TMP("WV",$J,1,N)) Q:N="" D
|
|
.S M=0
|
|
.F S M=$O(^TMP("WV",$J,1,N,M)) Q:M="" D
|
|
..S P=0
|
|
..F S P=$O(^TMP("WV",$J,1,N,M,P)) Q:P="" D
|
|
...S Q=0
|
|
...F S Q=$O(^TMP("WV",$J,1,N,M,P,Q)) Q:Q="" D
|
|
....S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M,P,Q)
|
|
Q
|
|
;
|
|
;
|
|
DEQUEUE ;EP
|
|
;---> EP FOR TASKMAN QUEUE OF PRINTOUT.
|
|
D SETVARS^WVUTL5,SORT^WVPROF2,COPYGBL,^WVPROF1,EXIT
|
|
Q
|
|
;
|
|
HELP1 ;EP
|
|
;;Enter "D" for a "Detailed" listing of the patient's Procedures,
|
|
;;Notifications, PAP Regimen and Pregnancy changes.
|
|
;;Enter "B" for a "Brief" listing of the patient's Procedures only.
|
|
S WVTAB=5,WVLINL="HELP1" D HELPTX
|
|
Q
|
|
;
|
|
HELPTX ;EP
|
|
;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
|
|
N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
|
F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
|
|
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
|
|
Q
|
|
;
|
|
;
|
|
USER ;EP
|
|
;---> CALLED BY OPTION: "WV PATIENT PROFILE USER"
|
|
;---> FOR USER TO VIEW PROFILE AND PRINT PROCEDURES, BUT NO EDIT.
|
|
S WVPUSER=1
|
|
D WVPROF K WVPUSER
|
|
Q
|
|
;
|
|
ERRORS ;EP
|
|
;---> CALLED BY OPTION: "WV PATIENT PROFILE W/ERRORS"
|
|
;---> ENTER HERE TO INCLUDE ERRONEOUS ENTRIES.
|
|
S WVERRORS=0 G WVPROF
|
|
Q
|