WVBRNOT ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE NOTIFICATIONS; ;7/30/98 11:02
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "WV BROWSE NOTIFICATIONS" TO BROWSE AND EDIT
;; NOTIFICATIONS.
;
;---> VARIABLES:
;---> WVA: 1=ALL PATIENTS, 0=ONE PATIENT
;---> WVDFN: DFN OF SELECTED PATIENT
;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
;---> WVB: d=DELINQUENT, o=OPEN, q=queued, a=ALL (includes CLOSED).
;---> SORT SEQUENCE IN WVC: 1=DATE, PATIENT, PRIORITY
;---> 2=PATIENT, DATE, PRIORITY
;---> 3=PRIORITY, DATE, PATIENT
;---> USE NODES 3 & 4 IN ^TMP GLOBAL.
;
D SETVARS^WVUTL5
D ^WVBRNOT2 G:WVPOP EXIT
D SORT
D COPYGBL
D ^WVBRNOT1
;
EXIT ;EP
D KILLALL^WVUTL8
Q
;
;
SORT ;EP
;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
K ^TMP("WV",$J)
;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
;---> WVENDDT1=THE LAST SECOND OF END DATE.
S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
;
;**************************
;---> WVA=1: ALL PATIENTS
I WVA D Q
.;---> BY DATE GET EITHER ALL OR OPEN ONLY.
.N WVDFN,WVIEN,Y
.S WVXREF=$S(WVB="a":"D",WVB="q":"APRT",1:"AOPEN")
.S WVDATE=WVBEGDT1
.F S WVDATE=$O(^WV(790.4,WVXREF,WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1) D
..S WVIEN=0
..F S WVIEN=$O(^WV(790.4,WVXREF,WVDATE,WVIEN)) Q:'WVIEN D
...Q:'$D(^WV(790.4,WVIEN,0))
...S Y=^WV(790.4,WVIEN,0),WVDFN=$P(Y,U)
...;---> QUIT IF SELECTING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
...I 'WVE Q:$P(^WV(790,WVDFN,0),U,10)'=WVCMGR
...;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
...I WVB="d" Q:$P(Y,U,13)'<DT!($P(Y,U,13)="")
...D STORE
;
;**************************
;---> WVA=0: ONE PATIENT
N WVIEN,Y S WVIEN=0
F S WVIEN=$O(^WV(790.4,"B",WVDFN,WVIEN)) Q:'WVIEN D
.S Y=^WV(790.4,WVIEN,0)
.;---> QUIT IF NOT WITHIN DATE RANGE.
.S WVDATE=$P(Y,U,2)
.Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)
.;---> QUIT IF "QUEUED" AND THIS NOTIFICATION IS NOT QUEUED.
.I WVB="q" Q:'$P(Y,U,11) Q:'$D(^WV(790.4,"APRT",$P(Y,U,11),WVIEN))
.;---> QUIT IF "DELINQUENT" OR OPEN ONLY AND THIS ENTRY IS CLOSED.
.Q:"do"[WVB&($P(Y,U,14)="c")
.I WVB="d" Q:$P(Y,U,13)'<DT!($P(Y,U,13)="")
.D STORE
Q
;
STORE ;EP
;--->WVDATE IS ALREADY SET FROM LL SORT ABOVE. ;---> DATE
S WVCHRT=$$SSN^WVUTL1(WVDFN)_" " ;---> SSN#
S WVNAME=$$NAME^WVUTL1(WVDFN) ;---> NAME
S WVACC=$P(Y,U,6) ;---> ACCESSION#
I WVACC]"" S WVACC=$P(^WV(790.1,WVACC,0),U)
S WVSTAT=$$STATUS^WVUTL4 ;---> STATUS
S WVPRIO=9
S:$P(Y,U,4)]"" WVPRIO=$P(^WV(790.404,$P(Y,U,4),0),U,2) ;---> PRIORITY
;
S X=WVCHRT_U_WVNAME_U_WVDATE_U_WVACC_U_WVSTAT_U_WVPRIO_U_WVIEN
I WVC=1 S ^TMP("WV",$J,3,WVDATE,WVNAME,WVPRIO,WVIEN)=X Q
I WVC=2 S ^TMP("WV",$J,3,WVNAME,WVDATE,WVPRIO,WVIEN)=X Q
I WVC=3 S ^TMP("WV",$J,3,WVPRIO,WVDATE,WVNAME,WVIEN)=X
Q
;
COPYGBL ;EP
;---> COPY ^TMP("WV",$J,3 TO ^TMP("WV",$J,4 TO MAKE IT FLAT.
N I,M,N,P,Q
S N=0,I=0
F S N=$O(^TMP("WV",$J,3,N)) Q:N="" D
.S M=0
.F S M=$O(^TMP("WV",$J,3,N,M)) Q:M="" D
..S P=0
..F S P=$O(^TMP("WV",$J,3,N,M,P)) Q:P="" D
...S Q=0
...F S Q=$O(^TMP("WV",$J,3,N,M,P,Q)) Q:Q="" D
....S I=I+1,^TMP("WV",$J,4,I)=^TMP("WV",$J,3,N,M,P,Q)
Q
;
;
DEQUEUE ;EP
;---> TASKMAN QUEUE OF PRINTOUT.
D SETVARS^WVUTL5,SORT,COPYGBL,^WVBRNOT1,EXIT
Q
;
FOLLOW(WVDFN) ;EP
;---> CALLED FROM PROCEDURE FOLLOWUP MENU.
D SETVARS^WVUTL5
S WVA=0,WVB="o",WVBEGDT=(DT-50000),WVC=1,WVE=1,WVENDDT=DT
D DEVICE^WVBRNOT2 Q:WVPOP
S WVLOOP=1
D SORT,COPYGBL,^WVBRNOT1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVBRNOT 3747 printed Dec 13, 2024@02:46:45 Page 2
WVBRNOT ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE NOTIFICATIONS; ;7/30/98 11:02
+1 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "WV BROWSE NOTIFICATIONS" TO BROWSE AND EDIT
+4 ;; NOTIFICATIONS.
+5 ;
+6 ;---> VARIABLES:
+7 ;---> WVA: 1=ALL PATIENTS, 0=ONE PATIENT
+8 ;---> WVDFN: DFN OF SELECTED PATIENT
+9 ;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
+10 ;---> WVB: d=DELINQUENT, o=OPEN, q=queued, a=ALL (includes CLOSED).
+11 ;---> SORT SEQUENCE IN WVC: 1=DATE, PATIENT, PRIORITY
+12 ;---> 2=PATIENT, DATE, PRIORITY
+13 ;---> 3=PRIORITY, DATE, PATIENT
+14 ;---> USE NODES 3 & 4 IN ^TMP GLOBAL.
+15 ;
+16 DO SETVARS^WVUTL5
+17 DO ^WVBRNOT2
if WVPOP
GOTO EXIT
+18 DO SORT
+19 DO COPYGBL
+20 DO ^WVBRNOT1
+21 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
+3 ;
+4 ;
SORT ;EP
+1 ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
+2 KILL ^TMP("WV",$JOB)
+3 ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
+4 ;---> WVENDDT1=THE LAST SECOND OF END DATE.
+5 SET WVBEGDT1=WVBEGDT-.0001
SET WVENDDT1=WVENDDT+.9999
+6 ;
+7 ;**************************
+8 ;---> WVA=1: ALL PATIENTS
+9 IF WVA
Begin DoDot:1
+10 ;---> BY DATE GET EITHER ALL OR OPEN ONLY.
+11 NEW WVDFN,WVIEN,Y
+12 SET WVXREF=$SELECT(WVB="a":"D",WVB="q":"APRT",1:"AOPEN")
+13 SET WVDATE=WVBEGDT1
+14 FOR
SET WVDATE=$ORDER(^WV(790.4,WVXREF,WVDATE))
if 'WVDATE!(WVDATE>WVENDDT1)
QUIT
Begin DoDot:2
+15 SET WVIEN=0
+16 FOR
SET WVIEN=$ORDER(^WV(790.4,WVXREF,WVDATE,WVIEN))
if 'WVIEN
QUIT
Begin DoDot:3
+17 if '$DATA(^WV(790.4,WVIEN,0))
QUIT
+18 SET Y=^WV(790.4,WVIEN,0)
SET WVDFN=$PIECE(Y,U)
+19 ;---> QUIT IF SELECTING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
+20 IF 'WVE
if $PIECE(^WV(790,WVDFN,0),U,10)'=WVCMGR
QUIT
+21 ;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
+22 IF WVB="d"
if $PIECE(Y,U,13)'<DT!($PIECE(Y,U,13)="")
QUIT
+23 DO STORE
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+24 ;
+25 ;**************************
+26 ;---> WVA=0: ONE PATIENT
+27 NEW WVIEN,Y
SET WVIEN=0
+28 FOR
SET WVIEN=$ORDER(^WV(790.4,"B",WVDFN,WVIEN))
if 'WVIEN
QUIT
Begin DoDot:1
+29 SET Y=^WV(790.4,WVIEN,0)
+30 ;---> QUIT IF NOT WITHIN DATE RANGE.
+31 SET WVDATE=$PIECE(Y,U,2)
+32 if WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)
QUIT
+33 ;---> QUIT IF "QUEUED" AND THIS NOTIFICATION IS NOT QUEUED.
+34 IF WVB="q"
if '$PIECE(Y,U,11)
QUIT
if '$DATA(^WV(790.4,"APRT",$PIECE(Y,U,11),WVIEN))
QUIT
+35 ;---> QUIT IF "DELINQUENT" OR OPEN ONLY AND THIS ENTRY IS CLOSED.
+36 if "do"[WVB&($PIECE(Y,U,14)="c")
QUIT
+37 IF WVB="d"
if $PIECE(Y,U,13)'<DT!($PIECE(Y,U,13)="")
QUIT
+38 DO STORE
End DoDot:1
+39 QUIT
+40 ;
STORE ;EP
+1 ;--->WVDATE IS ALREADY SET FROM LL SORT ABOVE. ;---> DATE
+2 ;---> SSN#
SET WVCHRT=$$SSN^WVUTL1(WVDFN)_" "
+3 ;---> NAME
SET WVNAME=$$NAME^WVUTL1(WVDFN)
+4 ;---> ACCESSION#
SET WVACC=$PIECE(Y,U,6)
+5 IF WVACC]""
SET WVACC=$PIECE(^WV(790.1,WVACC,0),U)
+6 ;---> STATUS
SET WVSTAT=$$STATUS^WVUTL4
+7 SET WVPRIO=9
+8 ;---> PRIORITY
if $PIECE(Y,U,4)]""
SET WVPRIO=$PIECE(^WV(790.404,$PIECE(Y,U,4),0),U,2)
+9 ;
+10 SET X=WVCHRT_U_WVNAME_U_WVDATE_U_WVACC_U_WVSTAT_U_WVPRIO_U_WVIEN
+11 IF WVC=1
SET ^TMP("WV",$JOB,3,WVDATE,WVNAME,WVPRIO,WVIEN)=X
QUIT
+12 IF WVC=2
SET ^TMP("WV",$JOB,3,WVNAME,WVDATE,WVPRIO,WVIEN)=X
QUIT
+13 IF WVC=3
SET ^TMP("WV",$JOB,3,WVPRIO,WVDATE,WVNAME,WVIEN)=X
+14 QUIT
+15 ;
COPYGBL ;EP
+1 ;---> COPY ^TMP("WV",$J,3 TO ^TMP("WV",$J,4 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,3,N))
if N=""
QUIT
Begin DoDot:1
+5 SET M=0
+6 FOR
SET M=$ORDER(^TMP("WV",$JOB,3,N,M))
if M=""
QUIT
Begin DoDot:2
+7 SET P=0
+8 FOR
SET P=$ORDER(^TMP("WV",$JOB,3,N,M,P))
if P=""
QUIT
Begin DoDot:3
+9 SET Q=0
+10 FOR
SET Q=$ORDER(^TMP("WV",$JOB,3,N,M,P,Q))
if Q=""
QUIT
Begin DoDot:4
+11 SET I=I+1
SET ^TMP("WV",$JOB,4,I)=^TMP("WV",$JOB,3,N,M,P,Q)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;
DEQUEUE ;EP
+1 ;---> TASKMAN QUEUE OF PRINTOUT.
+2 DO SETVARS^WVUTL5
DO SORT
DO COPYGBL
DO ^WVBRNOT1
DO EXIT
+3 QUIT
+4 ;
FOLLOW(WVDFN) ;EP
+1 ;---> CALLED FROM PROCEDURE FOLLOWUP MENU.
+2 DO SETVARS^WVUTL5
+3 SET WVA=0
SET WVB="o"
SET WVBEGDT=(DT-50000)
SET WVC=1
SET WVE=1
SET WVENDDT=DT
+4 DO DEVICE^WVBRNOT2
if WVPOP
QUIT
+5 SET WVLOOP=1
+6 DO SORT
DO COPYGBL
DO ^WVBRNOT1
+7 QUIT
