DGPTFM8 ;ALB/MTC - PTF ADDITIONAL QUESTION DISPLAY FOR MAS SCREEN ;25 APR 91
;;5.3;Registration;**729,850**;Aug 13, 1993;Build 171
;
; 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 information for additional PTF questions by movement
S DG300A="" I $D(M(J)),$D(^DGPT(PTF,"M",+M(J),300)) S DG300A=^(300)
I DG300A']"" G WD3Q
S (DGCA,DGCB)=2
D GETNUM^DGPTSCAN
S DGL=0
;850 Only one movement per line change
F DGI=0:0 S X=DGCA,DG300=DG300A D PRN1 S DGCA=X+1 Q:(DGCA>DGFNUM)
WD3Q ;
K DGFNUM,DGI,DG300,DG300A,DG300B,DGL,DGCA,DGCB
Q
PRN1 ;-- display additional PTF question information
I X=2,$P(DG300,U,2)]"" W !?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)]"" W !?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)]"" W !?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
W !?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
SD3Q K DGSUR,DGL
Q
KID ;-- kidney transplant source
W:('DGL)&($X>0) !
I $D(^DGPT(PTF,"S",DGSUR,300)),$P(^(300),U)]"" W " Kidney - "_$S(+^(300)=1:"Live Donor",1:"Cadaver")
Q
PRN2 ;-- display additional PTF question information
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTFM8 2331 printed Jan 18, 2025@03:53:08 Page 2
DGPTFM8 ;ALB/MTC - PTF ADDITIONAL QUESTION DISPLAY FOR MAS SCREEN ;25 APR 91
+1 ;;5.3;Registration;**729,850**;Aug 13, 1993;Build 171
+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 information 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 IF DG300A']""
GOTO WD3Q
+3 SET (DGCA,DGCB)=2
+4 DO GETNUM^DGPTSCAN
+5 SET DGL=0
+6 ;850 Only one movement per line change
+7 FOR DGI=0:0
SET X=DGCA
SET DG300=DG300A
DO PRN1
SET DGCA=X+1
if (DGCA>DGFNUM)
QUIT
WD3Q ;
+1 KILL DGFNUM,DGI,DG300,DG300A,DG300B,DGL,DGCA,DGCB
+2 QUIT
PRN1 ;-- display additional PTF question information
+1 IF X=2
IF $PIECE(DG300,U,2)]""
WRITE !?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)]""
WRITE !?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)]""
WRITE !?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 WRITE !?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
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 " Kidney - "_$SELECT(+^(300)=1:"Live Donor",1:"Cadaver")
+3 QUIT
PRN2 ;-- display additional PTF question information
+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
