81 lines
2.3 KiB
Mathematica
81 lines
2.3 KiB
Mathematica
DGPTAPA1 ;ALB/MTC - PTF A/P ARCHIVE UTILITY ; 10-19-92
|
|
;;5.3;Registration;;Aug 13, 1993
|
|
;
|
|
ARINT ;
|
|
D ARMAIN,AR401^DGPTAPA2,AR601^DGPTAPA2,AR501^DGPTAPA3,AR535^DGPTAPA3
|
|
Q
|
|
;
|
|
ARMAIN ;-- This function will load the array containing the
|
|
; PTF detailed information.
|
|
; INPUT : DGPTF - Valid PTF entry
|
|
; DGTMP - IEN of the template used
|
|
;
|
|
N I,X,Y,DG70,NUMREC,SEQ,OSEQ,REF
|
|
;--
|
|
S OSEQ=$G(^DGP(45.62,DGTMP,100,0)) Q:OSEQ']""
|
|
S SEQ=$P(OSEQ,U,3),REF="^DGP(45.62,"_DGTMP_",100)"
|
|
S DG70=$G(^DGPT(DGPTF,70))
|
|
;
|
|
;--patient name (2)
|
|
S Y=DGPTF_U_$P(^DPT(+^DGPT(DGPTF,0),0),U)
|
|
;--admission date (3)
|
|
S Y=Y_U_$P(^DGPT(DGPTF,0),U,2)
|
|
;--discharge date (4)
|
|
S Y=Y_U_$S(+DG70:+DG70,1:"")
|
|
;--discharge specilaty (5)
|
|
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)
|
|
;--type of disposition (6)
|
|
S Y=Y_U_$S(X:$P($P($P(^DD(45,72,0),U,3),";",X),":",2),1:"")
|
|
S X=$P(DG70,U,14)
|
|
;--discharge status (7)
|
|
S Y=Y_U_$S(X:$P($P($P(^DD(45,72.1,0),U,3),";",X),":",2),1:"")
|
|
S X=$P(DG70,U,4)
|
|
;--outpatient treatment (8)
|
|
S Y=Y_U_$S(X=1:"YES",1:"NO")
|
|
;-- ASIH days (9)
|
|
S Y=Y_U_$S($P(DG70,U,8)]"":$P(DG70,U,8),1:"")
|
|
S X=$P(DG70,U,9)
|
|
;-- C&P Status (10)
|
|
S Y=Y_U_$S(X:$P($P($P(^DD(45,78,0),U,3),";",X),":",2),1:"")
|
|
;-- VA Auspices (11)
|
|
S Y=Y_U_$S($P(DG70,U,5)=1:"YES",1:"NO")
|
|
;-- income (12)
|
|
S DGINC=$P($G(^DGPT(DGPTF,101)),U,7)
|
|
S Y=Y_U_$S(DGINC]"":DGINC,1:"")
|
|
;
|
|
;-- check for ICD codes (13-22)
|
|
F I=10,15:1:24 D
|
|
. S Y=Y_U_$S($P(DG70,U,I):$P(^ICD9($P(DG70,U,I),0),U),1:"")
|
|
;
|
|
;-- check for 300 node information (23-28)
|
|
S X=$G(^DGPT(DGPTF,300))
|
|
S Y=Y_U_$$AR300(X),SEQ=SEQ+1,@REF@(SEQ,0)=Y
|
|
;
|
|
;-- update
|
|
S $P(^DGP(45.62,DGTMP,100,0),U,3,4)=SEQ_U_SEQ
|
|
;
|
|
Q
|
|
;
|
|
AR300(N300) ;-- load 300 node information
|
|
; INPUT N300 - Contains 300 node
|
|
; OUTPUT - Load display array
|
|
;
|
|
N Y,X
|
|
;-- suicide indicator
|
|
S Y=$S($P(N300,U,2)=1:"Attempted",$P(N300,U,2)=2:"Accomplished",1:"")_U
|
|
;-- legionnaire's
|
|
S Y=Y_$S($P(N300,U,3)=1:"YES",1:"NO")_U
|
|
;-- abused substance
|
|
S Y=Y_$S($P(N300,U,4):$P($G(^DIC(45.61,$P(N300,U,4),0)),U),1:"")_U
|
|
;-- psych class severity
|
|
I $P(N300,U,5)]"" D
|
|
. S X=$P(N300,U,5)
|
|
. S Y=Y_$S(X]"":$P($P($P(^DD(45.02,300.05,0),U,3),";",X),":",2),1:"")_U
|
|
I $P(N300,U,5)="" S Y=Y_U
|
|
;-- current func assessment
|
|
S Y=Y_$S($P(N300,U,6):$P(N300,U,6),1:"")_U
|
|
;-- high level psych class
|
|
S Y=Y_$S($P(N300,U,7):$P(N300,U,7),1:"")_U
|
|
Q Y
|
|
;
|