- 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:"")