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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1DGPTAPA1 ;ALB/MTC - PTF A/P ARCHIVE UTILITY ; 10-19-92
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4ARINT ;
5 D ARMAIN,AR401^DGPTAPA2,AR601^DGPTAPA2,AR501^DGPTAPA3,AR535^DGPTAPA3
6 Q
7 ;
8ARMAIN ;-- This function will load the array containing the
9 ; PTF detailed information.
10 ; INPUT : DGPTF - Valid PTF entry
11 ; DGTMP - IEN of the template used
12 ;
13 N I,X,Y,DG70,NUMREC,SEQ,OSEQ,REF
14 ;--
15 S OSEQ=$G(^DGP(45.62,DGTMP,100,0)) Q:OSEQ']""
16 S SEQ=$P(OSEQ,U,3),REF="^DGP(45.62,"_DGTMP_",100)"
17 S DG70=$G(^DGPT(DGPTF,70))
18 ;
19 ;--patient name (2)
20 S Y=DGPTF_U_$P(^DPT(+^DGPT(DGPTF,0),0),U)
21 ;--admission date (3)
22 S Y=Y_U_$P(^DGPT(DGPTF,0),U,2)
23 ;--discharge date (4)
24 S Y=Y_U_$S(+DG70:+DG70,1:"")
25 ;--discharge specilaty (5)
26 S Y=Y_U_$S($P(DG70,U,2):$P(^DIC(42.4,$P(DG70,U,2),0),U),1:""),X=$P(DG70,U,3)
27 ;--type of disposition (6)
28 S Y=Y_U_$S(X:$P($P($P(^DD(45,72,0),U,3),";",X),":",2),1:"")
29 S X=$P(DG70,U,14)
30 ;--discharge status (7)
31 S Y=Y_U_$S(X:$P($P($P(^DD(45,72.1,0),U,3),";",X),":",2),1:"")
32 S X=$P(DG70,U,4)
33 ;--outpatient treatment (8)
34 S Y=Y_U_$S(X=1:"YES",1:"NO")
35 ;-- ASIH days (9)
36 S Y=Y_U_$S($P(DG70,U,8)]"":$P(DG70,U,8),1:"")
37 S X=$P(DG70,U,9)
38 ;-- C&P Status (10)
39 S Y=Y_U_$S(X:$P($P($P(^DD(45,78,0),U,3),";",X),":",2),1:"")
40 ;-- VA Auspices (11)
41 S Y=Y_U_$S($P(DG70,U,5)=1:"YES",1:"NO")
42 ;-- income (12)
43 S DGINC=$P($G(^DGPT(DGPTF,101)),U,7)
44 S Y=Y_U_$S(DGINC]"":DGINC,1:"")
45 ;
46 ;-- check for ICD codes (13-22)
47 F I=10,15:1:24 D
48 . S Y=Y_U_$S($P(DG70,U,I):$P(^ICD9($P(DG70,U,I),0),U),1:"")
49 ;
50 ;-- check for 300 node information (23-28)
51 S X=$G(^DGPT(DGPTF,300))
52 S Y=Y_U_$$AR300(X),SEQ=SEQ+1,@REF@(SEQ,0)=Y
53 ;
54 ;-- update
55 S $P(^DGP(45.62,DGTMP,100,0),U,3,4)=SEQ_U_SEQ
56 ;
57 Q
58 ;
59AR300(N300) ;-- load 300 node information
60 ; INPUT N300 - Contains 300 node
61 ; OUTPUT - Load display array
62 ;
63 N Y,X
64 ;-- suicide indicator
65 S Y=$S($P(N300,U,2)=1:"Attempted",$P(N300,U,2)=2:"Accomplished",1:"")_U
66 ;-- legionnaire's
67 S Y=Y_$S($P(N300,U,3)=1:"YES",1:"NO")_U
68 ;-- abused substance
69 S Y=Y_$S($P(N300,U,4):$P($G(^DIC(45.61,$P(N300,U,4),0)),U),1:"")_U
70 ;-- psych class severity
71 I $P(N300,U,5)]"" D
72 . S X=$P(N300,U,5)
73 . S Y=Y_$S(X]"":$P($P($P(^DD(45.02,300.05,0),U,3),";",X),":",2),1:"")_U
74 I $P(N300,U,5)="" S Y=Y_U
75 ;-- current func assessment
76 S Y=Y_$S($P(N300,U,6):$P(N300,U,6),1:"")_U
77 ;-- high level psych class
78 S Y=Y_$S($P(N300,U,7):$P(N300,U,7),1:"")_U
79 Q Y
80 ;
Note: See TracBrowser for help on using the repository browser.