123 lines
4.5 KiB
Mathematica
123 lines
4.5 KiB
Mathematica
WVBRPCD ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES; ;7/30/98 11:07
|
|
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; CALLED BY OPTION: "WV BROWSE PROCEDURES" TO BROWSE AND EDIT
|
|
;; PROCEDURES.
|
|
;
|
|
;---> VARIABLES:
|
|
;---> WVA: 1=ALL PATIENTS, 0=ONE PATIENT
|
|
;---> WVDFN: DFN OF SELECTED PATIENT
|
|
;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
|
|
;---> WVD: 1=BOTH ABNORMAL AND NORMAL, 0=NORMAL ONLY
|
|
;---> SORT SEQUENCE IN WVC: 1=DATE, PATIENT, PRIORITY
|
|
;---> 2=PATIENT, DATE, PRIORITY
|
|
;---> 3=PRIORITY, DATE, PATIENT
|
|
;---> USE NODES 1 & 2 IN ^TMP GLOBAL
|
|
;
|
|
D SETVARS^WVUTL5 S WVPOP=0
|
|
D ^WVBRPCD2 G:WVPOP EXIT
|
|
D SORT
|
|
D COPYGBL
|
|
;---> NEXT LINE: PASS TITLE, HEADER (IN ^WVUTL7), AND CODE TO
|
|
;---> EXECUTE BY DIR AT BOTTOM OF SCREEN.
|
|
D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
|
|
;
|
|
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 ABNORMAL ONLY.
|
|
.;---> ("INSUFFICIENT TISSUE" IS INCLUDED IN ABNML XREF.)
|
|
.S WVXREF=$S(WVD:"D",1:"ABNML")
|
|
.S WVDATE=WVBEGDT1
|
|
.F S WVDATE=$O(^WV(790.1,WVXREF,WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1) D
|
|
..S WVIEN=0
|
|
..F S WVIEN=$O(^WV(790.1,WVXREF,WVDATE,WVIEN)) Q:'WVIEN D
|
|
...S Y=^WV(790.1,WVIEN,0),WVDFN=$P(Y,U,2)
|
|
...;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
|
|
...Q:$P(Y,U,5)=8
|
|
...;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
|
|
...;---> NOT ONE OF THE SELECTED PROCEDURES.
|
|
...I '$D(WVARR("ALL")) Q:'$D(WVARR($P(Y,U,4)))
|
|
...;---> QUIT IF NOT "ALL PROCEDURES" AND THIS ENTRY IS "CLOSED".
|
|
...Q:WVB'="a"&($P(Y,U,14)="c")
|
|
...;---> 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)="")
|
|
...;---> QUIT IF LISTING "NEW" AND THIS PROCDURE IS NOT NEW.
|
|
...;Q:WVB="n"&($P(Y,U,14)'="n")
|
|
...D STORE(WVC,WVIEN,Y)
|
|
;
|
|
;**********************
|
|
;---> WVA=0 ONE PATIENT
|
|
S WVIEN=0
|
|
F S WVIEN=$O(^WV(790.1,"C",WVDFN,WVIEN)) Q:'WVIEN D
|
|
.;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE.
|
|
.S Y=^WV(790.1,WVIEN,0)
|
|
.;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
|
|
.Q:$P(Y,U,5)=8
|
|
.;---> QUIT IF NOT WITHIN DATE RANGE.
|
|
.S WVDATE=$P(Y,U,12)
|
|
.Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)
|
|
.;---> QUIT IF SELECTING FOR "ABNORMAL" ONLY AND THIS PROCEDURE
|
|
.;---> "NORMAL". ("INSUFF TISSUE" AND "UNSAT EXAM" WILL BE "ABNORMAL".)
|
|
.Q:'WVD&('$$NORMAL^WVUTL4($P(Y,U,5)))
|
|
.;---> QUIT IF "DELINQUENT" OR "OPEN" ONLY AND THIS ENTRY IS "CLOSED".
|
|
.Q:WVB'="a"&($P(Y,U,14)="c")
|
|
.;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
|
|
.I WVB="d" Q:$P(Y,U,13)>DT!($P(Y,U,13)="")
|
|
.;Q:WVB="n"&($P(Y,U,14)'="n")
|
|
.D STORE(WVC,WVIEN,Y)
|
|
Q
|
|
;
|
|
STORE(WVC,WVIEN,Y) ;EP
|
|
;---> CALLED TO STORE PROCEDURES IN ^TMP FOR BROWSING.
|
|
;---> WVC=LIST ORDER, WVIEN=IEN OR PROCEDURE, Y=ZERO NODE OF PROCEDURE.
|
|
S WVDFN=$P(Y,U,2),WVDATE=$P(Y,U,12) ;---> DFN, DATE
|
|
S WVCHRT=$$SSN^WVUTL1(WVDFN)_" " ;---> SSN#
|
|
S WVNAME=$$NAME^WVUTL1(WVDFN) ;---> NAME
|
|
S WVACC=$P(Y,U) ;---> ACCESSION#
|
|
S WVSTAT=$E($$STATUS^WVUTL4) ;---> STATUS
|
|
S WVDIAG=$$DIAG^WVUTL4($P(Y,U,5)) ;---> RESULT/DIAG
|
|
S X=$P(Y,U,5),WVPRIO=$$PRIOR^WVUTL4 K X ;---> PRIORITY
|
|
;
|
|
S X=WVCHRT_U_WVNAME_U_WVDATE_U_WVACC_U_WVDIAG_U_WVPRIO_U_WVSTAT_U_WVIEN
|
|
I WVC=1 S ^TMP("WV",$J,1,WVDATE,WVNAME,WVPRIO,WVIEN)=X Q
|
|
I WVC=2 S ^TMP("WV",$J,1,WVNAME,WVDATE,WVPRIO,WVIEN)=X Q
|
|
I WVC=3 S ^TMP("WV",$J,1,WVPRIO,WVDATE,WVNAME,WVIEN)=X
|
|
Q
|
|
;
|
|
COPYGBL ;EP
|
|
;---> CALLED TO FLATTEN THE ^TMP ARRAY OF PROCEDURES FOR BROWSING.
|
|
;---> 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
|
|
;---> FOR TASKMAN QUEUE OF PRINTOUT.
|
|
D SETVARS^WVUTL5,SORT,COPYGBL
|
|
D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
|
|
D EXIT
|
|
Q
|