DGPTFM8 ;ALB/MTC - PTF ADDITIONAL QUESTION DISPLAY FOR MAS SCREEN ; 25 APR 91
;;5.3;Registration;**729,1015**;Aug 13, 1993;Build 21
;
; This routine has two entry points WD3 and SD3, called from
; DGPTFM. This entry points will display Additional PTF information
; on the <MAS> screen.
;
WD3 ;-- display infor for additional PTF questions by movement
S DG300A="" I $D(M(J)),$D(^DGPT(PTF,"M",+M(J),300)) S DG300A=^(300)
S DG300B="" I $D(M(J+1)),$D(^DGPT(PTF,"M",+M(J+1),300)) S DG300B=^(300)
I DG300A']"",DG300B']"" G WD3Q
S (DGCA,DGCB)=2
D GETNUM^DGPTSCAN
F DGI=0:0 S DGL=0,X=DGCA,DG300=DG300A D PRN1 S DGCA=X+1,DGL=1,X=DGCB,DG300=DG300B D PRN1 S DGCB=X+1 Q:(DGCA>DGFNUM)&(DGCB>DGFNUM)
WD3Q ;
K DGFNUM,DGI,DG300,DG300A,DG300B,DGL,DGCA,DGCB
Q
PRN1 ;-- display additional PTF question infomation
I X=2,$P(DG300,U,2)]"" X:('DGL)!($X>40) "W !" W ?DGL*40+2,"Self Injury - "_$S($P(DG300,U,2)=1:"Attempted Suicide",$P(DG300,U,2)=2:"Accomplished Suicide",1:"Self Inflicted Injury") G PRNQ1
S:X=2 X=3
I X=3,$P(DG300,U,3)]"" X:('DGL)!($X>40) "W !" W ?DGL*40+2,"Legionnaire's - "_$S($P(DG300,U,3)=1:"Yes",1:"No") G PRNQ1
S:X=3 X=4
I X=4,$P(DG300,U,4)]"" X:('DGL)!($X>40) "W !" W ?DGL*40+2,"Substance - "_$S($D(^DIC(45.61,$P(DG300,U,4),0)):$P(^(0),U),1:"") G PRNQ1
S:X=4 X=5
S DGPSY=0 I "5,6,7"[X S X=7 F DGJ=5,6,7 I $P(DG300,U,DGJ)]"" S DGPSY=1 Q
G PRNQ1:'DGPSY
X:('DGL)!($X>40) "W !" W ?DGL*40+2,"Psy- CL:",+$P(DG300,U,5),?DGL*40+13," CR:",+$P(DG300,U,6),?DGL*40+21," HI:",+$P(DG300,U,7)
PRNQ1 ;
K DGJ,DGPSY
Q
SD3 ;-- tag for printing kidney donor source
; call only by DGPTFM@SERV
S DGL=0
S DGSUR=J D:$D(S(DGSUR)) KID S DGL=1,DGSUR=J+1 D:$D(S(DGSUR)) KID
SD3Q K DGSUR,DGL
Q
KID ;-- kidney transplant source
W:('DGL)&($X>0) !
I $D(^DGPT(PTF,"S",DGSUR,300)),$P(^(300),U)]"" W ?DGL*40+2,"Kidney - "_$S(+^(300)=1:"Live Donor",1:"Cadaver")
Q
PRN2 ;-- display additional PTF question infomation
I $P(DG300,U,2)]"" W !,"Self Injury - "_$S($P(DG300,U,2)=1:"Attempted Suicide",$P(DG300,U,2)=2:"Accomplished Suicide",1:"Self Inflicted Injury")
I $P(DG300,U,3)]"" W !,"Legionnaire's - "_$S($P(DG300,U,3)=1:"Yes",1:"No")
I $P(DG300,U,4)]"" W !,"Substance - "_$S($D(^DIC(45.61,$P(DG300,U,4),0)):$P(^(0),U),1:"")
S DGPSY=0 F DGI=5,6,7 I $P(DG300,U,DGI)]"" S DGPSY=1 Q
G PRNQ2:'DGPSY
W !,"Psy - CL:",+$P(DG300,U,5),?12,"CR:",+$P(DG300,U,6),?19,"HI:",+$P(DG300,U,7)
PRNQ2 ;
K DGI,DGPSY
Q
PRN3 ;-- print kidney additional question
I $P(DG300,U)]"" W !,"Kidney - "_$S(+DG300=1:"Live Donor",1:"Cadaver")
PRNQ3 ;
Q
DGPTFM8 ;ALB/MTC - PTF ADDITIONAL QUESTION DISPLAY FOR MAS SCREEN ; 25 APR 91
+1 ;;5.3;Registration;**729,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; This routine has two entry points WD3 and SD3, called from
+4 ; DGPTFM. This entry points will display Additional PTF information
+5 ; on the <MAS> screen.
+6 ;
WD3 ;-- display infor for additional PTF questions by movement
+1 SET DG300A=""
IF $DATA(M(J))
IF $DATA(^DGPT(PTF,"M",+M(J),300))
SET DG300A=^(300)
+2 SET DG300B=""
IF $DATA(M(J+1))
IF $DATA(^DGPT(PTF,"M",+M(J+1),300))
SET DG300B=^(300)
+3 IF DG300A']""
IF DG300B']""
GOTO WD3Q
+4 SET (DGCA,DGCB)=2
+5 DO GETNUM^DGPTSCAN
+6 FOR DGI=0:0
SET DGL=0
SET X=DGCA
SET DG300=DG300A
DO PRN1
SET DGCA=X+1
SET DGL=1
SET X=DGCB
SET DG300=DG300B
DO PRN1
SET DGCB=X+1
IF (DGCA>DGFNUM)&(DGCB>DGFNUM)
QUIT
WD3Q ;
+1 KILL DGFNUM,DGI,DG300,DG300A,DG300B,DGL,DGCA,DGCB
+2 QUIT
PRN1 ;-- display additional PTF question infomation
+1 IF X=2
IF $PIECE(DG300,U,2)]""
IF ('DGL)!($X>40)
XECUTE "W !"
WRITE ?DGL*40+2,"Self Injury - "_$SELECT($PIECE(DG300,U,2)=1:"Attempted Suicide",$PIECE(DG300,U,2)=2:"Accomplished Suicide",1:"Self Inflicted Injury")
GOTO PRNQ1
+2 IF X=2
SET X=3
+3 IF X=3
IF $PIECE(DG300,U,3)]""
IF ('DGL)!($X>40)
XECUTE "W !"
WRITE ?DGL*40+2,"Legionnaire's - "_$SELECT($PIECE(DG300,U,3)=1:"Yes",1:"No")
GOTO PRNQ1
+4 IF X=3
SET X=4
+5 IF X=4
IF $PIECE(DG300,U,4)]""
IF ('DGL)!($X>40)
XECUTE "W !"
WRITE ?DGL*40+2,"Substance - "_$SELECT($DATA(^DIC(45.61,$PIECE(DG300,U,4),0)):$PIECE(^(0),U),1:"")
GOTO PRNQ1
+6 IF X=4
SET X=5
+7 SET DGPSY=0
IF "5,6,7"[X
SET X=7
FOR DGJ=5,6,7
IF $PIECE(DG300,U,DGJ)]""
SET DGPSY=1
QUIT
+8 IF 'DGPSY
GOTO PRNQ1
+9 IF ('DGL)!($X>40)
XECUTE "W !"
WRITE ?DGL*40+2,"Psy- CL:",+$PIECE(DG300,U,5),?DGL*40+13," CR:",+$PIECE(DG300,U,6),?DGL*40+21," HI:",+$PIECE(DG300,U,7)
PRNQ1 ;
+1 KILL DGJ,DGPSY
+2 QUIT
SD3 ;-- tag for printing kidney donor source
+1 ; call only by DGPTFM@SERV
+2 SET DGL=0
+3 SET DGSUR=J
IF $DATA(S(DGSUR))
DO KID
SET DGL=1
SET DGSUR=J+1
IF $DATA(S(DGSUR))
DO KID
SD3Q KILL DGSUR,DGL
+1 QUIT
KID ;-- kidney transplant source
+1 IF ('DGL)&($X>0)
WRITE !
+2 IF $DATA(^DGPT(PTF,"S",DGSUR,300))
IF $PIECE(^(300),U)]""
WRITE ?DGL*40+2,"Kidney - "_$SELECT(+^(300)=1:"Live Donor",1:"Cadaver")
+3 QUIT
PRN2 ;-- display additional PTF question infomation
+1 IF $PIECE(DG300,U,2)]""
WRITE !,"Self Injury - "_$SELECT($PIECE(DG300,U,2)=1:"Attempted Suicide",$PIECE(DG300,U,2)=2:"Accomplished Suicide",1:"Self Inflicted Injury")
+2 IF $PIECE(DG300,U,3)]""
WRITE !,"Legionnaire's - "_$SELECT($PIECE(DG300,U,3)=1:"Yes",1:"No")
+3 IF $PIECE(DG300,U,4)]""
WRITE !,"Substance - "_$SELECT($DATA(^DIC(45.61,$PIECE(DG300,U,4),0)):$PIECE(^(0),U),1:"")
+4 SET DGPSY=0
FOR DGI=5,6,7
IF $PIECE(DG300,U,DGI)]""
SET DGPSY=1
QUIT
+5 IF 'DGPSY
GOTO PRNQ2
+6 WRITE !,"Psy - CL:",+$PIECE(DG300,U,5),?12,"CR:",+$PIECE(DG300,U,6),?19,"HI:",+$PIECE(DG300,U,7)
PRNQ2 ;
+1 KILL DGI,DGPSY
+2 QUIT
PRN3 ;-- print kidney additional question
+1 IF $PIECE(DG300,U)]""
WRITE !,"Kidney - "_$SELECT(+DG300=1:"Live Donor",1:"Cadaver")
PRNQ3 ;
+1 QUIT
