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