ACPTSINF ; IHS/ASDST/DMJ,SDR - SET INACTIVE FLAG ; [ 01/05/2004 9:35 AM ]
;;2.08;CPT FILES;;DEC 17, 2007
I '$G(DT) D NOW^%DTC S DT=X
S ACPTDA=0
F S ACPTDA=$O(^ICPT(ACPTDA)) Q:'ACPTDA!(ACPTDA>999999) D
.D ACT
.D INA
.Q:$D(ZTQUEUED)
.D DOTS^ACPTPOST(ACPTDA)
;
S ACPTDA=4848484969
F S ACPTDA=$O(^ICPT(ACPTDA)) Q:'ACPTDA!(ACPTDA>5248494971) D
.D ACT
.D INA
.Q:$D(ZTQUEUED)
.D DOTS^ACPTPOST(ACPTDA)
Q
;
; EFFECTIVE DATE - 0=INACTIVE; 1=ACTIVE
;
ACT ;MAKE INACTIVE CODE ACTIVE
;Q:'$P(^ICPT(ACPTDA,0),"^",4)&($P(^ICPT(ACPTDA,0),U,6)'=3070000)
S ABMINAFG=1
S ABMEDT=$O(^ICPT(ACPTDA,60,"B",9999999),-1) ;get most recent date
Q:+ABMEDT=0
S ABMEDIEN=$O(^ICPT(ACPTDA,60,"B",ABMEDT,0)) ;IEN for most recent entry
I $P($G(^ICPT(ACPTDA,60,ABMEDIEN,0)),U,2)=0 S ABMINAFG=0 ;set inactive flag
Q:'$P(^ICPT(ACPTDA,0),"^",4)&($P(^ICPT(ACPTDA,0),U,6)'=3080000)&(ABMINAFG=1)
S ACPTADT=$P($G(^ICPT(ACPTDA,0)),"^",6)
Q:'ACPTADT
Q:ACPTADT>DT
S $P(^ICPT(ACPTDA,0),"^",4)=""
K DIC
S DA(1)=ACPTDA
S DIC="^ICPT("_DA(1)_",60,"
S DIC(0)="L"
S DIC("P")=$P(^DD(81,60,0),"^",2)
S X="01/01/2008"
;S DIC("DR")=".02////1" acpt*2.07*1
D ^DIC
;start new code acpt*2.07*1
S DA=+Y
K DIC,X,Y
S DA(1)=ACPTDA
S DIE="^ICPT("_DA(1)_",60,"
S DR=".02////1"
D ^DIE
;end new code acpt*2.07*1
K ACPTADT
Q
INA ;MAKE ACTIVE CODE INACTIVE
;Q:$P(^ICPT(ACPTDA,0),"^",4) ;acpt*2.07*1
S ACPTIDT=$P($G(^ICPT(ACPTDA,0)),"^",7)
Q:'ACPTIDT
Q:ACPTIDT>DT
S $P(^ICPT(ACPTDA,0),"^",4)=1
K DIC
S DA(1)=ACPTDA
S DIC="^ICPT("_DA(1)_",60,"
S DIC(0)="L"
S DIC("P")=$P(^DD(81,60,0),"^",2)
S (DA,X)="01/01/2008"
;S DIC("DR")=".02////0" ;acpt*2.07*1
D ^DIC
;start new code acpt*2.07*1
S DA=+Y
K DIC,X,Y
S DA(1)=ACPTDA
S DIE="^ICPT("_DA(1)_",60,"
S DR=".02////0"
D ^DIE
;end new code acpt*2.07*1
K ACPTIDT
Q
ACPTSINF ; IHS/ASDST/DMJ,SDR - SET INACTIVE FLAG ; [ 01/05/2004 9:35 AM ]
+1 ;;2.08;CPT FILES;;DEC 17, 2007
+2 IF '$GET(DT)
DO NOW^%DTC
SET DT=X
+3 SET ACPTDA=0
+4 FOR
SET ACPTDA=$ORDER(^ICPT(ACPTDA))
IF 'ACPTDA!(ACPTDA>999999)
QUIT
Begin DoDot:1
+5 DO ACT
+6 DO INA
+7 IF $DATA(ZTQUEUED)
QUIT
+8 DO DOTS^ACPTPOST(ACPTDA)
End DoDot:1
+9 ;
+10 SET ACPTDA=4848484969
+11 FOR
SET ACPTDA=$ORDER(^ICPT(ACPTDA))
IF 'ACPTDA!(ACPTDA>5248494971)
QUIT
Begin DoDot:1
+12 DO ACT
+13 DO INA
+14 IF $DATA(ZTQUEUED)
QUIT
+15 DO DOTS^ACPTPOST(ACPTDA)
End DoDot:1
+16 QUIT
+17 ;
+18 ; EFFECTIVE DATE - 0=INACTIVE; 1=ACTIVE
+19 ;
ACT ;MAKE INACTIVE CODE ACTIVE
+1 ;Q:'$P(^ICPT(ACPTDA,0),"^",4)&($P(^ICPT(ACPTDA,0),U,6)'=3070000)
+2 SET ABMINAFG=1
+3 ;get most recent date
SET ABMEDT=$ORDER(^ICPT(ACPTDA,60,"B",9999999),-1)
+4 IF +ABMEDT=0
QUIT
+5 ;IEN for most recent entry
SET ABMEDIEN=$ORDER(^ICPT(ACPTDA,60,"B",ABMEDT,0))
+6 ;set inactive flag
IF $PIECE($GET(^ICPT(ACPTDA,60,ABMEDIEN,0)),U,2)=0
SET ABMINAFG=0
+7 IF '$PIECE(^ICPT(ACPTDA,0),"^",4)&($PIECE(^ICPT(ACPTDA,0),U,6)'=3080000)&(ABMINAFG=1)
QUIT
+8 SET ACPTADT=$PIECE($GET(^ICPT(ACPTDA,0)),"^",6)
+9 IF 'ACPTADT
QUIT
+10 IF ACPTADT>DT
QUIT
+11 SET $PIECE(^ICPT(ACPTDA,0),"^",4)=""
+12 KILL DIC
+13 SET DA(1)=ACPTDA
+14 SET DIC="^ICPT("_DA(1)_",60,"
+15 SET DIC(0)="L"
+16 SET DIC("P")=$PIECE(^DD(81,60,0),"^",2)
+17 SET X="01/01/2008"
+18 ;S DIC("DR")=".02////1" acpt*2.07*1
+19 DO ^DIC
+20 ;start new code acpt*2.07*1
+21 SET DA=+Y
+22 KILL DIC,X,Y
+23 SET DA(1)=ACPTDA
+24 SET DIE="^ICPT("_DA(1)_",60,"
+25 SET DR=".02////1"
+26 DO ^DIE
+27 ;end new code acpt*2.07*1
+28 KILL ACPTADT
+29 QUIT
INA ;MAKE ACTIVE CODE INACTIVE
+1 ;Q:$P(^ICPT(ACPTDA,0),"^",4) ;acpt*2.07*1
+2 SET ACPTIDT=$PIECE($GET(^ICPT(ACPTDA,0)),"^",7)
+3 IF 'ACPTIDT
QUIT
+4 IF ACPTIDT>DT
QUIT
+5 SET $PIECE(^ICPT(ACPTDA,0),"^",4)=1
+6 KILL DIC
+7 SET DA(1)=ACPTDA
+8 SET DIC="^ICPT("_DA(1)_",60,"
+9 SET DIC(0)="L"
+10 SET DIC("P")=$PIECE(^DD(81,60,0),"^",2)
+11 SET (DA,X)="01/01/2008"
+12 ;S DIC("DR")=".02////0" ;acpt*2.07*1
+13 DO ^DIC
+14 ;start new code acpt*2.07*1
+15 SET DA=+Y
+16 KILL DIC,X,Y
+17 SET DA(1)=ACPTDA
+18 SET DIE="^ICPT("_DA(1)_",60,"
+19 SET DR=".02////0"
+20 DO ^DIE
+21 ;end new code acpt*2.07*1
+22 KILL ACPTIDT
+23 QUIT
