ADGCRB3 ; IHS/ADC/PDW/ENM - A SHEET lines 5&6 ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
A ; -- main
D INI,H5,L5,H6,L6,H61,L61 Q
;
INI ; -- mailing address, next of kin, emergency contact
S DGN11=$G(^DPT(DFN,.11)),DGN21=$G(^(.21)),DGN33=$G(^(.33)) Q
;
H5 ; -- sub heading 5
W !,DGLIN1,!,"9 Present Address",?62,"22 Length of Stay",! Q
;
L5 ; -- data line 5
I DGN11="" W ?6,"UNKNOWN" Q
W ?2,$P(DGN11,U)," ",$P(DGN11,U,4),$$STM," ",$P(DGN11,U,6),?67,$$LOS Q
;
H6 ; -- sub heading 6a
W !,DGLIN1,!,"23 Next of Kin",?25,"Telephone"
W ?45,"Address",?60,"Relationship",! Q
;
L6 ; -- data line 6a
I DGN21="" W ?6,"UNKNOWN" Q
W $E($P(DGN21,U),1,23),?22,$P(DGN21,U,9)," ",$P(DGN21,U,3)," ",$P(DGN21,U,6)
W $$STN," ",$P(DGN21,U,8)," ",$$R21 Q
;
H61 ; -- sub heading 6b
W !,"24 Person to Notify",! Q
;
L61 ; -- date line 6b
I DGN33="" W ?6,"UNKNOWN" Q
W $E($P(DGN33,U),1,23),?22,$P(DGN33,U,9)," ",$P(DGN33,U,3)," ",$P(DGN33,U,6)
W $$STC," ",$P(DGN33,U,8)," ",$$R33 Q
;
STM() ; -- state mailing
Q ", "_$P($G(^DIC(5,+$P(DGN11,U,5),0)),U,2)
;
STN() ; -- state nok
Q ", "_$P($G(^DIC(5,+$P(DGN21,U,7),0)),U,2)
;
STC() ; -- state emergency contact
Q ", "_$P($G(^DIC(5,+$P(DGN33,U,7),0)),U,2)
;
R21() ; -- relationship, nok
Q $P($G(^AUTTRLSH(+$P($G(^AUPNPAT(DFN,28)),U,2),0)),U)
;
R33() ; -- relationship, person to notify
Q $P($G(^AUTTRLSH(+$P($G(^AUPNPAT(DFN,31)),U,2),0)),U)
;
LOS() ; -- length of stay
I DGDS N X D Q X_" hrs"
. K ^UTILITY("DIQ1",$J) S DR(9009012.01)=8,DA(9009012.01)=DGDS
. S DIC=9009012,DA=DFN,DR=1 D EN^DIQ1
. S X=$G(^UTILITY("DIQ1",$J,9009012.01,DGDS,8)) K ^UTILITY("DIQ1",$J)
Q:'$P(^DGPM(DGFN,0),U,17) ""
N X,DGPMIFN S DGPMIFN=DGFN D ^DGPMLOS Q $S($D(X):$P(X,U,5)_" days",1:"")
ADGCRB3 ; IHS/ADC/PDW/ENM - A SHEET lines 5&6 ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
A ; -- main
+1 DO INI
DO H5
DO L5
DO H6
DO L6
DO H61
DO L61
QUIT
+2 ;
INI ; -- mailing address, next of kin, emergency contact
+1 SET DGN11=$GET(^DPT(DFN,.11))
SET DGN21=$GET(^(.21))
SET DGN33=$GET(^(.33))
QUIT
+2 ;
H5 ; -- sub heading 5
+1 WRITE !,DGLIN1,!,"9 Present Address",?62,"22 Length of Stay",!
QUIT
+2 ;
L5 ; -- data line 5
+1 IF DGN11=""
WRITE ?6,"UNKNOWN"
QUIT
+2 WRITE ?2,$PIECE(DGN11,U)," ",$PIECE(DGN11,U,4),$$STM," ",$PIECE(DGN11,U,6),?67,$$LOS
QUIT
+3 ;
H6 ; -- sub heading 6a
+1 WRITE !,DGLIN1,!,"23 Next of Kin",?25,"Telephone"
+2 WRITE ?45,"Address",?60,"Relationship",!
QUIT
+3 ;
L6 ; -- data line 6a
+1 IF DGN21=""
WRITE ?6,"UNKNOWN"
QUIT
+2 WRITE $EXTRACT($PIECE(DGN21,U),1,23),?22,$PIECE(DGN21,U,9)," ",$PIECE(DGN21,U,3)," ",$PIECE(DGN21,U,6)
+3 WRITE $$STN," ",$PIECE(DGN21,U,8)," ",$$R21
QUIT
+4 ;
H61 ; -- sub heading 6b
+1 WRITE !,"24 Person to Notify",!
QUIT
+2 ;
L61 ; -- date line 6b
+1 IF DGN33=""
WRITE ?6,"UNKNOWN"
QUIT
+2 WRITE $EXTRACT($PIECE(DGN33,U),1,23),?22,$PIECE(DGN33,U,9)," ",$PIECE(DGN33,U,3)," ",$PIECE(DGN33,U,6)
+3 WRITE $$STC," ",$PIECE(DGN33,U,8)," ",$$R33
QUIT
+4 ;
STM() ; -- state mailing
+1 QUIT ", "_$PIECE($GET(^DIC(5,+$PIECE(DGN11,U,5),0)),U,2)
+2 ;
STN() ; -- state nok
+1 QUIT ", "_$PIECE($GET(^DIC(5,+$PIECE(DGN21,U,7),0)),U,2)
+2 ;
STC() ; -- state emergency contact
+1 QUIT ", "_$PIECE($GET(^DIC(5,+$PIECE(DGN33,U,7),0)),U,2)
+2 ;
R21() ; -- relationship, nok
+1 QUIT $PIECE($GET(^AUTTRLSH(+$PIECE($GET(^AUPNPAT(DFN,28)),U,2),0)),U)
+2 ;
R33() ; -- relationship, person to notify
+1 QUIT $PIECE($GET(^AUTTRLSH(+$PIECE($GET(^AUPNPAT(DFN,31)),U,2),0)),U)
+2 ;
LOS() ; -- length of stay
+1 IF DGDS
NEW X
Begin DoDot:1
+2 KILL ^UTILITY("DIQ1",$JOB)
SET DR(9009012.01)=8
SET DA(9009012.01)=DGDS
+3 SET DIC=9009012
SET DA=DFN
SET DR=1
DO EN^DIQ1
+4 SET X=$GET(^UTILITY("DIQ1",$JOB,9009012.01,DGDS,8))
KILL ^UTILITY("DIQ1",$JOB)
End DoDot:1
QUIT X_" hrs"
+5 IF '$PIECE(^DGPM(DGFN,0),U,17)
QUIT ""
+6 NEW X,DGPMIFN
SET DGPMIFN=DGFN
DO ^DGPMLOS
QUIT $SELECT($DATA(X):$PIECE(X,U,5)_" days",1:"")
