- ADGCRB4 ; IHS/ADC/PDW/ENM - A SHEET line 7 ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- A ; -- driver
- D H7,L7 Q
- ;
- H7 ; -- sub heading 7
- I DGDS D Q
- . W !,DGLIN1,!,"25 DX, Procedure & Comments",?41,"25a Medicaid #"
- W !,DGLIN1,!,"25 Admitting Diagnosis",?41,"25a Medicaid #" Q
- ;
- L7 ; -- data line 7
- NEW X
- W ?56,$$MCD,!?3,$$DX,?45,"Medicare #",?55,$$MCR,!?3,$$COM1
- W ?45,"Railroad #",?55,$$RRN,!?3,$$COM2
- W ?42,"Other Insur #" S X=$$INS
- F I=1:2 Q:$P(X,U,I)="" D
- . W ?55,$P(X,U,I) W:$P(X,U,I+1)]"" !?55,$P(X,U,I+1) W !
- Q
- ;
- MCD() ; -- medicaid number & elig date
- N X,X1,Y Q:'$D(^AUPNMCD("B",DFN)) ""
- S X=$O(^AUPNMCD("B",DFN,0)) Q:'X ""
- I '$D(^AUPNMCD(X,0)) Q ""
- S Y="",X1=0 F S X1=$O(^AUPNMCD(X,11,X1)) Q:'X1 S Y=X1
- I Y S Y=$P($G(^AUPNMCD(X,11,Y,0)),U,2) I Y S Y=$$DATE(Y)
- Q $P(^AUPNMCD(X,0),U,3)_" exp "_Y
- ;
- MCR() ; -- medicare # & suffix
- N X,Y Q:'$D(^AUPNMCR(DFN,0)) ""
- S X=^AUPNMCR(DFN,0),Y=$P(X,U,4)
- I +Y,$D(^AUTTMCS(Y,0)) S Y=^(0)
- Q $P(X,U,3)_Y
- ;
- RRN() ; -- railroad retirement # & prefix
- N X,Y Q:'$D(^AUPNRRE(DFN,0)) ""
- S X=^AUPNRRE(DFN,0),Y=$P(X,U,3)
- I +Y,$D(^AUTTRRP(Y,0)) S Y=^AUTTRRP(Y,0)
- Q Y_$P(X,U,4)
- ;
- INS() ; -- private insurance
- NEW X,Y,N,DATE
- Q:'$D(^AUPNPRVT(DFN)) ""
- S DATE=$$SRVDT
- S Y="",X=0 F S X=$O(^AUPNPRVT(DFN,11,X)) Q:'X D
- . S N=^AUPNPRVT(DFN,11,X,0) Q:N=""
- . Q:$P(N,U,6)>DATE ;elig not started
- . I $P(N,U,7)]"" Q:$P(N,U,7)<DATE ;elig over
- . S Y=Y_$P($G(^AUTNINS(+N,0)),U)_U_$P(N,U,2)_U
- Q Y
- ;
- COM1() ; -- comments line 1
- Q:DGDS $G(^ADGDS(DFN,"DS",+DGDS,1,1,0)) Q $E($G(^DGPM($$M6,"DX",1,0)),1,40)
- ;
- COM2() ; -- comments line 2
- Q:DGDS "Procedure: "_$P(DGN,U,2)
- Q $E($G(^DGPM($$M6,"DX",2,0)),1,40)
- ;
- M6() ; -- treating specialty ifn
- Q +$O(^DGPM("APHY",DGFN,0))
- ;
- DX() ; -- admitting diagnosis
- Q $S(DGDS:$P($G(^ADGDS(DFN,"DS",+DGDS,2)),U,7),1:$P(DGN,U,10))
- ;
- DATE(X) ; -- converts fm date to number date (mm/dd/yy)
- Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
- ;
- SRVDT() ; -- finds service date
- Q $S(DGDS:+^ADGDS(DFN,"DS",DGDS,0),1:+^DGPM(DGFN,0))
- ADGCRB4 ; IHS/ADC/PDW/ENM - A SHEET line 7 ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- A ; -- driver
- +1 DO H7
- DO L7
- QUIT
- +2 ;
- H7 ; -- sub heading 7
- +1 IF DGDS
- Begin DoDot:1
- +2 WRITE !,DGLIN1,!,"25 DX, Procedure & Comments",?41,"25a Medicaid #"
- End DoDot:1
- QUIT
- +3 WRITE !,DGLIN1,!,"25 Admitting Diagnosis",?41,"25a Medicaid #"
- QUIT
- +4 ;
- L7 ; -- data line 7
- +1 NEW X
- +2 WRITE ?56,$$MCD,!?3,$$DX,?45,"Medicare #",?55,$$MCR,!?3,$$COM1
- +3 WRITE ?45,"Railroad #",?55,$$RRN,!?3,$$COM2
- +4 WRITE ?42,"Other Insur #"
- SET X=$$INS
- +5 FOR I=1:2
- IF $PIECE(X,U,I)=""
- QUIT
- Begin DoDot:1
- +6 WRITE ?55,$PIECE(X,U,I)
- IF $PIECE(X,U,I+1)]""
- WRITE !?55,$PIECE(X,U,I+1)
- WRITE !
- End DoDot:1
- +7 QUIT
- +8 ;
- MCD() ; -- medicaid number & elig date
- +1 NEW X,X1,Y
- IF '$DATA(^AUPNMCD("B",DFN))
- QUIT ""
- +2 SET X=$ORDER(^AUPNMCD("B",DFN,0))
- IF 'X
- QUIT ""
- +3 IF '$DATA(^AUPNMCD(X,0))
- QUIT ""
- +4 SET Y=""
- SET X1=0
- FOR
- SET X1=$ORDER(^AUPNMCD(X,11,X1))
- IF 'X1
- QUIT
- SET Y=X1
- +5 IF Y
- SET Y=$PIECE($GET(^AUPNMCD(X,11,Y,0)),U,2)
- IF Y
- SET Y=$$DATE(Y)
- +6 QUIT $PIECE(^AUPNMCD(X,0),U,3)_" exp "_Y
- +7 ;
- MCR() ; -- medicare # & suffix
- +1 NEW X,Y
- IF '$DATA(^AUPNMCR(DFN,0))
- QUIT ""
- +2 SET X=^AUPNMCR(DFN,0)
- SET Y=$PIECE(X,U,4)
- +3 IF +Y
- IF $DATA(^AUTTMCS(Y,0))
- SET Y=^(0)
- +4 QUIT $PIECE(X,U,3)_Y
- +5 ;
- RRN() ; -- railroad retirement # & prefix
- +1 NEW X,Y
- IF '$DATA(^AUPNRRE(DFN,0))
- QUIT ""
- +2 SET X=^AUPNRRE(DFN,0)
- SET Y=$PIECE(X,U,3)
- +3 IF +Y
- IF $DATA(^AUTTRRP(Y,0))
- SET Y=^AUTTRRP(Y,0)
- +4 QUIT Y_$PIECE(X,U,4)
- +5 ;
- INS() ; -- private insurance
- +1 NEW X,Y,N,DATE
- +2 IF '$DATA(^AUPNPRVT(DFN))
- QUIT ""
- +3 SET DATE=$$SRVDT
- +4 SET Y=""
- SET X=0
- FOR
- SET X=$ORDER(^AUPNPRVT(DFN,11,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +5 SET N=^AUPNPRVT(DFN,11,X,0)
- IF N=""
- QUIT
- +6 ;elig not started
- IF $PIECE(N,U,6)>DATE
- QUIT
- +7 ;elig over
- IF $PIECE(N,U,7)]""
- IF $PIECE(N,U,7)<DATE
- QUIT
- +8 SET Y=Y_$PIECE($GET(^AUTNINS(+N,0)),U)_U_$PIECE(N,U,2)_U
- End DoDot:1
- +9 QUIT Y
- +10 ;
- COM1() ; -- comments line 1
- +1 IF DGDS
- QUIT $GET(^ADGDS(DFN,"DS",+DGDS,1,1,0))
- QUIT $EXTRACT($GET(^DGPM($$M6,"DX",1,0)),1,40)
- +2 ;
- COM2() ; -- comments line 2
- +1 IF DGDS
- QUIT "Procedure: "_$PIECE(DGN,U,2)
- +2 QUIT $EXTRACT($GET(^DGPM($$M6,"DX",2,0)),1,40)
- +3 ;
- M6() ; -- treating specialty ifn
- +1 QUIT +$ORDER(^DGPM("APHY",DGFN,0))
- +2 ;
- DX() ; -- admitting diagnosis
- +1 QUIT $SELECT(DGDS:$PIECE($GET(^ADGDS(DFN,"DS",+DGDS,2)),U,7),1:$PIECE(DGN,U,10))
- +2 ;
- DATE(X) ; -- converts fm date to number date (mm/dd/yy)
- +1 QUIT $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- +2 ;
- SRVDT() ; -- finds service date
- +1 QUIT $SELECT(DGDS:+^ADGDS(DFN,"DS",DGDS,0),1:+^DGPM(DGFN,0))
