- ACMRLU1 ; IHS/TUCSON/TMJ - GEN RETR UTILITIES ; [ 07/15/1999 7:57 AM ]
- ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996
- ;IHS/CMI/LAB - patch 1 Y2K
- ;
- MCR ;display all current medicare data
- NEW ACMMIFN
- I '$D(^DPT(P,0)) G MCRX
- I $P(^DPT(P,0),U,19) G MCRX
- I '$D(^AUPNPAT(P,0)) G MCRX
- I '$D(^AUPNMCR(P,11)) G MCRX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
- S ACMMIFN=0 F S ACMMIFN=$O(^AUPNMCR(P,11,ACMMIFN)) Q:ACMMIFN'=+ACMMIFN D
- .Q:$P(^AUPNMCR(P,11,ACMMIFN,0),U)>D
- .I $P(^AUPNMCR(P,11,ACMMIFN,0),U,2)]"",$P(^(0),U,2)<D Q
- .S ACMPCNT=ACMPCNT+1,ACMPRNM(ACMPCNT)=$P(^AUPNMCR(DFN,0),U,3)_" ["_$S($P(^(0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"-")_"]"
- .;being Y2K
- .;S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNMCR(DFN,11,ACMMIFN,0),U),Z=$P(^(0),U,2),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3) ;Y2000
- .S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNMCR(DFN,11,ACMMIFN,0),U),Z=$P(^(0),U,2),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_"-" ;Y2000
- .I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_(1700+$E(Z,1,3)) ;Y2000
- .;end Y2K
- .Q
- MCRX ;
- K Y,Z
- Q
- ;
- MCD ;
- NEW ACMMIFN,ACMNIFN
- I '$D(^DPT(P,0)) G MCDX
- I $P(^DPT(P,0),U,19) G MCDX
- I '$D(^AUPNPAT(P,0)) G MCDX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
- S ACMMIFN=0 F S ACMMIFN=$O(^AUPNMCD("B",P,ACMMIFN)) Q:ACMMIFN'=+ACMMIFN D
- .Q:'$D(^AUPNMCD(ACMMIFN,11))
- .S ACMNIFN=0 F S ACMNIFN=$O(^AUPNMCD(ACMMIFN,11,ACMNIFN)) Q:ACMNIFN'=+ACMNIFN D
- ..Q:ACMNIFN>D
- ..I $P(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
- ..S ACMPCNT=ACMPCNT+1,ACMPRNM(ACMPCNT)=$P(^AUPNMCD(ACMMIFN,0),U,3)_"/"_$S($P(^AUPNMCD(ACMMIFN,0),U,2)]"":$P(^AUTNINS($P(^AUPNMCD(ACMMIFN,0),U,2),0),U),1:"<>")
- ..;begin Y2K
- ..;S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U),Z=$P(^(0),U,2),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3) ;Y2000
- ..S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U),Z=$P(^(0),U,2),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_"-" ;Y2000
- ..I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_(1700+$E(Z,1,3)) ;Y2000
- ..;end Y2K
- ..Q
- .Q
- ;
- MCDX ;
- Q
- ;
- PI ;
- NEW ACMMIFN,ACMFLG
- I '$D(^DPT(P,0)) G PIX
- I $P(^DPT(P,0),U,19) G PIX
- I '$D(^AUPNPAT(P,0)) G PIX
- I '$D(^AUPNPRVT(P,11)) G PIX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
- S ACMMIFN=0 F S ACMMIFN=$O(^AUPNPRVT(P,11,ACMMIFN)) Q:ACMMIFN'=+ACMMIFN D
- .Q:$P(^AUPNPRVT(P,11,ACMMIFN,0),U)=""
- .S ACMNAME=$P(^AUPNPRVT(DFN,11,ACMMIFN,0),U) Q:ACMNAME=""
- .Q:$P(^AUTNINS(ACMNAME,0),U)["AHCCCS"
- .Q:$P(^AUPNPRVT(P,11,ACMMIFN,0),U,6)>D
- .I $P(^AUPNPRVT(P,11,ACMMIFN,0),U,7)]"",$P(^(0),U,7)<D Q
- .S ACMPCNT=ACMPCNT+1,ACMPRNM(ACMPCNT)=$P(^AUTNINS($P(^AUPNPRVT(P,11,ACMMIFN,0),U),0),U)
- .;begin Y2K
- .;S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNPRVT(DFN,11,ACMMIFN,0),U,6),Z=$P(^(0),U,7),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3) ;Y2000
- .S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNPRVT(DFN,11,ACMMIFN,0),U,6),Z=$P(^(0),U,7) I Y]"" S ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_"-" ;Y2000
- .I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_(1700+$E(Z,1,3)) ;Y2000
- .;end Y2K
- .Q
- PIX ;
- Q
- ACMRLU1 ; IHS/TUCSON/TMJ - GEN RETR UTILITIES ; [ 07/15/1999 7:57 AM ]
- +1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996
- +2 ;IHS/CMI/LAB - patch 1 Y2K
- +3 ;
- MCR ;display all current medicare data
- +1 NEW ACMMIFN
- +2 IF '$DATA(^DPT(P,0))
- GOTO MCRX
- +3 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCRX
- +4 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCRX
- +5 IF '$DATA(^AUPNMCR(P,11))
- GOTO MCRX
- +6 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCRX
- +7 SET ACMMIFN=0
- FOR
- SET ACMMIFN=$ORDER(^AUPNMCR(P,11,ACMMIFN))
- IF ACMMIFN'=+ACMMIFN
- QUIT
- Begin DoDot:1
- +8 IF $PIECE(^AUPNMCR(P,11,ACMMIFN,0),U)>D
- QUIT
- +9 IF $PIECE(^AUPNMCR(P,11,ACMMIFN,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +10 SET ACMPCNT=ACMPCNT+1
- SET ACMPRNM(ACMPCNT)=$PIECE(^AUPNMCR(DFN,0),U,3)_" ["_$SELECT($PIECE(^(0),U,4)]"":$PIECE(^AUTTMCS($PIECE(^(0),U,4),0),U),1:"-")_"]"
- +11 ;being Y2K
- +12 ;S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNMCR(DFN,11,ACMMIFN,0),U),Z=$P(^(0),U,2),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3) ;Y2000
- +13 ;Y2000
- SET ACMPCNT=ACMPCNT+1
- SET Y=$PIECE(^AUPNMCR(DFN,11,ACMMIFN,0),U)
- SET Z=$PIECE(^(0),U,2)
- SET ACMPRNM(ACMPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_(1700+$EXTRACT(Y,1,3))_"-"
- +14 ;Y2000
- IF Z]""
- SET ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_(1700+$EXTRACT(Z,1,3))
- +15 ;end Y2K
- +16 QUIT
- End DoDot:1
- MCRX ;
- +1 KILL Y,Z
- +2 QUIT
- +3 ;
- MCD ;
- +1 NEW ACMMIFN,ACMNIFN
- +2 IF '$DATA(^DPT(P,0))
- GOTO MCDX
- +3 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCDX
- +4 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCDX
- +5 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCDX
- +6 SET ACMMIFN=0
- FOR
- SET ACMMIFN=$ORDER(^AUPNMCD("B",P,ACMMIFN))
- IF ACMMIFN'=+ACMMIFN
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(^AUPNMCD(ACMMIFN,11))
- QUIT
- +8 SET ACMNIFN=0
- FOR
- SET ACMNIFN=$ORDER(^AUPNMCD(ACMMIFN,11,ACMNIFN))
- IF ACMNIFN'=+ACMNIFN
- QUIT
- Begin DoDot:2
- +9 IF ACMNIFN>D
- QUIT
- +10 IF $PIECE(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +11 SET ACMPCNT=ACMPCNT+1
- SET ACMPRNM(ACMPCNT)=$PIECE(^AUPNMCD(ACMMIFN,0),U,3)_"/"_$SELECT($PIECE(^AUPNMCD(ACMMIFN,0),U,2)]"":$PIECE(^AUTNINS($PIECE(^AUPNMCD(ACMMIFN,0),U,2),0),U),1:"<>")
- +12 ;begin Y2K
- +13 ;S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U),Z=$P(^(0),U,2),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3) ;Y2000
- +14 ;Y2000
- SET ACMPCNT=ACMPCNT+1
- SET Y=$PIECE(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U)
- SET Z=$PIECE(^(0),U,2)
- SET ACMPRNM(ACMPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_(1700+$EXTRACT(Y,1,3))_"-"
- +15 ;Y2000
- IF Z]""
- SET ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_(1700+$EXTRACT(Z,1,3))
- +16 ;end Y2K
- +17 QUIT
- End DoDot:2
- +18 QUIT
- End DoDot:1
- +19 ;
- MCDX ;
- +1 QUIT
- +2 ;
- PI ;
- +1 NEW ACMMIFN,ACMFLG
- +2 IF '$DATA(^DPT(P,0))
- GOTO PIX
- +3 IF $PIECE(^DPT(P,0),U,19)
- GOTO PIX
- +4 IF '$DATA(^AUPNPAT(P,0))
- GOTO PIX
- +5 IF '$DATA(^AUPNPRVT(P,11))
- GOTO PIX
- +6 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO PIX
- +7 SET ACMMIFN=0
- FOR
- SET ACMMIFN=$ORDER(^AUPNPRVT(P,11,ACMMIFN))
- IF ACMMIFN'=+ACMMIFN
- QUIT
- Begin DoDot:1
- +8 IF $PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U)=""
- QUIT
- +9 SET ACMNAME=$PIECE(^AUPNPRVT(DFN,11,ACMMIFN,0),U)
- IF ACMNAME=""
- QUIT
- +10 IF $PIECE(^AUTNINS(ACMNAME,0),U)["AHCCCS"
- QUIT
- +11 IF $PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U,6)>D
- QUIT
- +12 IF $PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U,7)]""
- IF $PIECE(^(0),U,7)<D
- QUIT
- +13 SET ACMPCNT=ACMPCNT+1
- SET ACMPRNM(ACMPCNT)=$PIECE(^AUTNINS($PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U),0),U)
- +14 ;begin Y2K
- +15 ;S ACMPCNT=ACMPCNT+1,Y=$P(^AUPNPRVT(DFN,11,ACMMIFN,0),U,6),Z=$P(^(0),U,7),ACMPRNM(ACMPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3) ;Y2000
- +16 ;Y2000
- SET ACMPCNT=ACMPCNT+1
- SET Y=$PIECE(^AUPNPRVT(DFN,11,ACMMIFN,0),U,6)
- SET Z=$PIECE(^(0),U,7)
- IF Y]""
- SET ACMPRNM(ACMPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_(1700+$EXTRACT(Y,1,3))_"-"
- +17 ;Y2000
- IF Z]""
- SET ACMPRNM(ACMPCNT)=ACMPRNM(ACMPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_(1700+$EXTRACT(Z,1,3))
- +18 ;end Y2K
- +19 QUIT
- End DoDot:1
- PIX ;
- +1 QUIT
