| 1 | DGPTAPA1 ;ALB/MTC - PTF A/P ARCHIVE UTILITY ; 10-19-92
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ARINT ;
|
|---|
| 5 | D ARMAIN,AR401^DGPTAPA2,AR601^DGPTAPA2,AR501^DGPTAPA3,AR535^DGPTAPA3
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | ARMAIN ;-- 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 | ;
|
|---|
| 59 | AR300(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 | ;
|
|---|
