source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFM8.m@ 1423

Last change on this file since 1423 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1DGPTFM8 ;ALB/MTC - PTF ADDITIONAL QUESTION DISPLAY FOR MAS SCREEN ; 25 APR 91
2 ;;5.3;Registration;**729**;Aug 13, 1993;Build 59
3 ;
4 ; This routine has two entry points WD3 and SD3, called from
5 ; DGPTFM. This entry points will display Additional PTF information
6 ; on the <MAS> screen.
7 ;
8WD3 ;-- display infor for additional PTF questions by movement
9 S DG300A="" I $D(M(J)),$D(^DGPT(PTF,"M",+M(J),300)) S DG300A=^(300)
10 S DG300B="" I $D(M(J+1)),$D(^DGPT(PTF,"M",+M(J+1),300)) S DG300B=^(300)
11 I DG300A']"",DG300B']"" G WD3Q
12 S (DGCA,DGCB)=2
13 D GETNUM^DGPTSCAN
14 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)
15WD3Q ;
16 K DGFNUM,DGI,DG300,DG300A,DG300B,DGL,DGCA,DGCB
17 Q
18PRN1 ;-- display additional PTF question infomation
19 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
20 S:X=2 X=3
21 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
22 S:X=3 X=4
23 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
24 S:X=4 X=5
25 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
26 G PRNQ1:'DGPSY
27 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)
28PRNQ1 ;
29 K DGJ,DGPSY
30 Q
31SD3 ;-- tag for printing kidney donor source
32 ; call only by DGPTFM@SERV
33 S DGL=0
34 S DGSUR=J D:$D(S(DGSUR)) KID S DGL=1,DGSUR=J+1 D:$D(S(DGSUR)) KID
35SD3Q K DGSUR,DGL
36 Q
37KID ;-- kidney transplant source
38 W:('DGL)&($X>0) !
39 I $D(^DGPT(PTF,"S",DGSUR,300)),$P(^(300),U)]"" W ?DGL*40+2,"Kidney - "_$S(+^(300)=1:"Live Donor",1:"Cadaver")
40 Q
41PRN2 ;-- display additional PTF question infomation
42 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")
43 I $P(DG300,U,3)]"" W !,"Legionnaire's - "_$S($P(DG300,U,3)=1:"Yes",1:"No")
44 I $P(DG300,U,4)]"" W !,"Substance - "_$S($D(^DIC(45.61,$P(DG300,U,4),0)):$P(^(0),U),1:"")
45 S DGPSY=0 F DGI=5,6,7 I $P(DG300,U,DGI)]"" S DGPSY=1 Q
46 G PRNQ2:'DGPSY
47 W !,"Psy - CL:",+$P(DG300,U,5),?12,"CR:",+$P(DG300,U,6),?19,"HI:",+$P(DG300,U,7)
48PRNQ2 ;
49 K DGI,DGPSY
50 Q
51PRN3 ;-- print kidney additional question
52 I $P(DG300,U)]"" W !,"Kidney - "_$S(+DG300=1:"Live Donor",1:"Cadaver")
53PRNQ3 ;
54 Q
Note: See TracBrowser for help on using the repository browser.