- 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
