168 lines
4.7 KiB
Mathematica
168 lines
4.7 KiB
Mathematica
WVDIAG ;HCIOFO/FT,JR IHS/ANMC/MWR - PRINTOUT OF WV DIAGNOSIS FILE; ;8/10/98 14:56
|
|
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; CALLED BY OPTION: "WV PRINT RES/DIAG FILE" TO PRINT THE
|
|
;; RESULTS/DIAGNOSIS TABLE FILE.
|
|
;
|
|
D SETUP
|
|
D TITLE^WVUTL5("LISTING OF RESULTS/DIAGNOSIS FILE")
|
|
D DEVICE I WVPOP D EXIT Q
|
|
D SORT
|
|
D DISPLAY
|
|
;
|
|
EXIT ;EP
|
|
D KILLALL^WVUTL8
|
|
Q
|
|
;
|
|
SETUP ;EP
|
|
D SETVARS^WVUTL5 S WVPOP=0
|
|
S WVLINE=$$REPEAT^XLFSTR("-",80)
|
|
Q
|
|
;
|
|
DEVICE ;EP
|
|
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
|
S ZTRTN="DEQUEUE^WVDIAG"
|
|
F WVSV="WVLINE","WVTITLE" D
|
|
.I $D(WVSV) S ZTSAVE(WVSV)=""
|
|
D ZIS^WVUTL2(.WVPOP,1)
|
|
Q
|
|
;
|
|
SORT ;EP
|
|
;---> SORT BY RESULT/DIAGNOSIS. STORED IN ^TMP("WV",$J,1
|
|
N N,X,Y K ^TMP("WV",$J)
|
|
S N=0
|
|
F S N=$O(^WV(790.31,"B",N)) Q:N="" D
|
|
.S M=$O(^WV(790.31,"B",N,0))
|
|
.S Y=^WV(790.31,M,0),WVDIAG=N
|
|
.F I=3:1:19 I $P(Y,U,I) D
|
|
..S WVPN=$E($P(^WV(790.2,$P(Y,U,I),0),U),1,30)
|
|
..S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
|
..S WVPRIO=$P(Y,U,2)
|
|
..S X=WVDIAG_U_WVPRIO_U_WVNORM_U_WVPN
|
|
..S ^TMP("WV",$J,1,WVDIAG,WVPN,1)=X
|
|
.I $P(Y,U,20) D
|
|
..S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
|
..S WVPRIO=$P(Y,U,2),WVPN="ALL PROCEDURES"
|
|
..S X=WVDIAG_U_WVPRIO_U_WVNORM_U_WVPN
|
|
..S ^TMP("WV",$J,1,WVDIAG,WVPN,1)=X
|
|
;
|
|
;---> SORT BY PROCEDURE TYPE. STORED IN ^TMP("WV",$J,2
|
|
S N=0
|
|
F S N=$O(^WV(790.31,"P",N)) Q:N="" D
|
|
.S M=0
|
|
.F S M=$O(^WV(790.31,"P",N,M)) Q:M="" D
|
|
..S Y=^WV(790.31,M,0)
|
|
..S WVPN=$P(^WV(790.2,N,0),U),WVDIAG=$P(Y,U)
|
|
..S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
|
..S WVPRIO=$P(Y,U,2)
|
|
..S X=WVPN_U_WVDIAG_U_WVPRIO_U_WVNORM
|
|
..S ^TMP("WV",$J,2,WVPN,WVPRIO,WVDIAG)=X
|
|
;
|
|
;---> ASSOCIATED WITH ALL PROCEDURES
|
|
S N=0
|
|
F S N=$O(^WV(790.31,N)) Q:'N D
|
|
.S Y=^WV(790.31,N,0)
|
|
.Q:'$P(Y,U,20)
|
|
.S WVDIAG=$P(Y,U),WVPRIO=$P(Y,U,2)
|
|
.S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
|
.S M=0
|
|
.F S M=$O(^WV(790.2,M)) Q:'M D
|
|
..S WVPN=$P(^WV(790.2,M,0),U)
|
|
..Q:$P(^WV(790.2,M,0),U,12)
|
|
..S X=WVPN_U_WVDIAG_U_WVPRIO_U_WVNORM
|
|
..S ^TMP("WV",$J,2,WVPN,WVPRIO,WVDIAG)=X
|
|
;
|
|
;---> SORT BY PRIORITY. STORED IN ^TMP("WV",$J,3
|
|
S N=0
|
|
F S N=$O(^WV(790.31,"B",N)) Q:N="" D
|
|
.S M=$O(^WV(790.31,"B",N,0))
|
|
.S Y=^WV(790.31,M,0),WVDIAG=N,WVPRIO=$P(Y,U,2)
|
|
.S X=$P(Y,U,21),WVNORM=$S(X=0:"NORMAL",X=2:"NO RES",1:"ABNORM")
|
|
.S X=WVDIAG_U_WVPRIO_U_WVNORM
|
|
.S ^TMP("WV",$J,3,WVPRIO,WVDIAG,1)=X
|
|
;
|
|
;---> COPY TO TMP IN A SINGLE SUBSCRIPT.
|
|
F WVS=1,2,3 S WVSS=WVS_WVS D COPYGBL
|
|
Q
|
|
;
|
|
DISPLAY ;EP
|
|
U IO
|
|
S WVTITLE1="* WOMEN'S HEALTH: LISTING OF RESULTS/DIAGNOSIS FILE *"
|
|
D CENTERT^WVUTL5(.WVTITLE1)
|
|
S WVCRT=$S($E(IOST)="C":1,1:0),(WVPAGE,WVPOP)=0
|
|
F WVI=22,33,11 D @("DISPLY"_WVI) Q:WVPOP
|
|
D ^%ZISC
|
|
Q
|
|
;
|
|
DISPLY11 ;EP
|
|
;---> LIST BY RESULT/DIAGNOSIS
|
|
;Q
|
|
S WVTITLE2=" * BY DIAGNOSIS *" D CENTERT^WVUTL5(.WVTITLE2)
|
|
S WVSUB="W !?3,""RESULT/DIAGNOSIS"",?31,""PRIORITY"",?42,""NORMAL"","
|
|
S WVSUB=WVSUB_"?50,""ASSOCIATED PROCEDURES"""
|
|
N Z S (WVPOP,N,Z)=0
|
|
W:WVCRT @IOF D HEADER
|
|
F S N=$O(^TMP("WV",$J,WVI,N)) Q:'N!(WVPOP) D
|
|
.I $Y+8>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
|
|
.S Y=^TMP("WV",$J,WVI,N) W !
|
|
.I $P(Y,U)'=Z W !?3,$P(Y,U),?37,$J($P(Y,U,2),2),?42,$P(Y,U,3)
|
|
.W ?50,$P(Y,U,4)
|
|
.S Z=$P(Y,U)
|
|
I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
|
|
Q
|
|
;
|
|
DISPLY22 ;EP
|
|
;---> LIST BY RESULT/DIAGNOSIS
|
|
S WVTITLE2=" * BY PROCEDURE *" D CENTERT^WVUTL5(.WVTITLE2)
|
|
S WVSUB="W !?3,""PROCEDURE"",?35,""RESULT/DIAGNOSIS"""
|
|
S WVSUB=WVSUB_",?62,""PRIORITY"",?72,""NORMAL"""
|
|
N Z S (WVPOP,N,Z)=0
|
|
W:WVCRT @IOF D HEADER
|
|
F S N=$O(^TMP("WV",$J,WVI,N)) Q:'N!(WVPOP) D
|
|
.I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
|
|
.S Y=^TMP("WV",$J,WVI,N) W !
|
|
.I $P(Y,U)'=Z W !?3,$P(Y,U)
|
|
.W ?35,$P(Y,U,2),?68,$J($P(Y,U,3),2),?72,$P(Y,U,4)
|
|
.S Z=$P(Y,U)
|
|
I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
|
|
Q
|
|
;
|
|
DISPLY33 ;EP
|
|
;---> LIST BY RESULT/DIAGNOSIS
|
|
S WVTITLE2=" * BY PRIORITY *" D CENTERT^WVUTL5(.WVTITLE2)
|
|
S WVSUB="W !?3,""RESULT/DIAGNOSIS"",?32,""PRIORITY"",?44,""NORMAL"""
|
|
N Z S (WVPOP,N,Z)=0
|
|
W:WVCRT @IOF D HEADER
|
|
F S N=$O(^TMP("WV",$J,WVI,N)) Q:'N!(WVPOP) D
|
|
.I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER
|
|
.S Y=^TMP("WV",$J,WVI,N)
|
|
.W !?3,$P(Y,U),?37,$J($P(Y,U,2),2),?44,$P(Y,U,3)
|
|
.S Z=$P(Y,U)
|
|
I WVCRT&('WVPOP) W !! D DIRZ^WVUTL3
|
|
Q
|
|
;
|
|
;
|
|
HEADER ;EP
|
|
W:WVPAGE @IOF S WVPAGE=WVPAGE+1,Z=0
|
|
W WVTITLE1,?70,"PAGE ",WVPAGE,!,WVTITLE2
|
|
W !,$$RUNDT^WVUTL1A("C")
|
|
W !,WVLINE X WVSUB W !,WVLINE
|
|
Q
|
|
;
|
|
COPYGBL ;EP
|
|
;---> COPY ^TMP("WV",$J,WVS TO ^TMP("WV",$J,WVSS TO MAKE IT FLAT.
|
|
N I,M,N,P,Q
|
|
S N=0,I=0
|
|
F S N=$O(^TMP("WV",$J,WVS,N)) Q:N="" D
|
|
.S M=0
|
|
.F S M=$O(^TMP("WV",$J,WVS,N,M)) Q:M="" D
|
|
..S P=0
|
|
..F S P=$O(^TMP("WV",$J,WVS,N,M,P)) Q:P="" D
|
|
...S I=I+1,^TMP("WV",$J,WVSS,I)=^TMP("WV",$J,WVS,N,M,P)
|
|
Q
|
|
;
|
|
DEQUEUE ;EP
|
|
;---> CALLED BY TASKMAN
|
|
D SETVARS^WVUTL5,SORT,DISPLAY,EXIT
|
|
Q
|