ACHSHVR2 ; IHS/ITSC/PMF - CHECK STATUS OF HV VENDOR NOTIFICATION REPORTS (2/2) ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
FILDELB ;EP
S ACHSI=""
FILDELB0 ;
S ACHSI=$O(ACHSUFLS(ACHSI))
G FILDELC:+ACHSI=0
FILDELB1 ;
S Y=$P(ACHSUFLS(ACHSI),U,5),ACHSDATE=$P(ACHSUFLS(ACHSI),U,2)
G:Y=""!(ACHSDATE="") FILDELB0
I '$D(^ACHSHVLG(Y)) S X=$P(^AUTTVNDR(Y,0),U,1),DA(1)=+Y,DIC="^ACHSHVLG(",DIC(0)="ZML" D ^DIC I +Y<1 U ACHSHMD W !,*7,"FACILITY LOOK-UP ERROR -- JOB CANCELLED" G ABEND
S ACHSVPT=+Y
I '$D(^ACHSHVLG(ACHSVPT,1,0)) S ^ACHSHVLG(ACHSVPT,1,0)=$$ZEROTH^ACHS(9002078,1)
I '$D(^ACHSHVLG(ACHSVPT,1,"B",ACHSDATE)) D DICN G FILDELB0
DREPCK ;
S (ACHSK,ACHSDFLG)=0
DREPCK1 ;
S ACHSK=$O(^ACHSHVLG(ACHSVPT,1,"B",ACHSDATE,ACHSK))
G DREPCKZ:+ACHSK=0
S ACHSRTY=$E($P(ACHSUFLS(ACHSI),U,3)),ACHSCMP=$P(^ACHSHVLG(ACHSVPT,1,ACHSK,0),U,2)
I ACHSRTY=ACHSCMP U ACHSHMD W *7,!,"REPORT ALREADY ON FILE FOR THIS DATE - SKIPPING ",$P($P(ACHSUFLS(ACHSI),U,1)," ",1),! S ACHSDFLG=ACHSDFLG+1
G DREPCK1
;
DREPCKZ ;
I ACHSDFLG=0 D DICN
G FILDELB0
;
FILDELC ;
S (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV,ACHSV)=0
FILDELC0 ;
S ACHSV=$O(ACHSUFLS("C",ACHSV))
G FILDELF:+ACHSV=0
FILDELC1 ;
S ACHSR=$O(ACHSUFLS("C",ACHSV,ACHSR))
G FILDELC0:+ACHSR=0
FILDELC2 ;
S ACHSRR=$O(ACHSUFLS("C",ACHSV,ACHSR,ACHSRR))
G FILDELC1:+ACHSRR=0
I ACHSR'=ACHSDSAV S ACHSCNT=ACHSCNT+1,ACHSDSAV=ACHSR
S ACHSCNT=ACHSCNT+1
I ACHSCNT=5 S ACHSDELD=9999999-ACHSR
G FILDELC2
;
FILDELF ;
G FILDEND:+ACHSDELD<5
FILDELG ;
U ACHSHMD
W !
K DIR
S DIR(0)="Y",DIR("A")="Delete ALL Vendor Note. Reports with DOS BEFORE "_$$FMTE^XLFDT(ACHSDELD),DIR("B")="Y"
D ^DIR
K DIR
I Y=1 G FILDELK
G FILDEND
;
FILDELK ;
S ACHSR=9999999-ACHSDELD
FILDELK1 ;
S ACHSR=$O(ACHSUFLS("C",ACHSR))
G FILDEND:+ACHSR=0
S ACHSRR="",ACHSRR=$O(ACHSUFLS("C",ACHSR,ACHSRR))
G FILDELK1:+ACHSRR=0
S ACHSZFN=$P($P(ACHSUFLS(ACHSRR),U)," ")
I '$$DEL^%ZISH($$AOP^ACHS(2,1),ACHSZFN) U ACHSHMD W !!?10,ACHSZFN," has been DELETED" K ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
G FILDELK1
;
FILDEND ;
Q
;
ABEND ;EP
U ACHSHMD
W *7,!!?10,"JOB ENDED WITH ERROR(S) - NOTIFY SUPERVISOR",!
D RTRN^ACHS
Q
;
DICN ;
S DIC="^ACHSHVLG("_ACHSVPT_",1,",DIC(0)="ZML",X=ACHSDATE,DA(1)=ACHSVPT
K DO,DD D FILE^DICN
S ACHSRTY=$E($P(ACHSUFLS(ACHSI),U,3)),ACHSCNT=$P(ACHSUFLS(ACHSI),U,4),ACHSVPT=$P(ACHSUFLS(ACHSI),U,5)
S $P(^ACHSHVLG(ACHSVPT,1,+Y,0),U,2)=ACHSRTY,$P(^ACHSHVLG(ACHSVPT,1,+Y,0),U,3)=ACHSCNT,$P(^ACHSHVLG(ACHSVPT,1,+Y,0),U,4)=$P($P(ACHSUFLS(ACHSI),U)," ")
Q
;
ACHSHVR2 ; IHS/ITSC/PMF - CHECK STATUS OF HV VENDOR NOTIFICATION REPORTS (2/2) ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
FILDELB ;EP
+1 SET ACHSI=""
FILDELB0 ;
+1 SET ACHSI=$ORDER(ACHSUFLS(ACHSI))
+2 IF +ACHSI=0
GOTO FILDELC
FILDELB1 ;
+1 SET Y=$PIECE(ACHSUFLS(ACHSI),U,5)
SET ACHSDATE=$PIECE(ACHSUFLS(ACHSI),U,2)
+2 IF Y=""!(ACHSDATE="")
GOTO FILDELB0
+3 IF '$DATA(^ACHSHVLG(Y))
SET X=$PIECE(^AUTTVNDR(Y,0),U,1)
SET DA(1)=+Y
SET DIC="^ACHSHVLG("
SET DIC(0)="ZML"
DO ^DIC
IF +Y<1
USE ACHSHMD
WRITE !,*7,"FACILITY LOOK-UP ERROR -- JOB CANCELLED"
GOTO ABEND
+4 SET ACHSVPT=+Y
+5 IF '$DATA(^ACHSHVLG(ACHSVPT,1,0))
SET ^ACHSHVLG(ACHSVPT,1,0)=$$ZEROTH^ACHS(9002078,1)
+6 IF '$DATA(^ACHSHVLG(ACHSVPT,1,"B",ACHSDATE))
DO DICN
GOTO FILDELB0
DREPCK ;
+1 SET (ACHSK,ACHSDFLG)=0
DREPCK1 ;
+1 SET ACHSK=$ORDER(^ACHSHVLG(ACHSVPT,1,"B",ACHSDATE,ACHSK))
+2 IF +ACHSK=0
GOTO DREPCKZ
+3 SET ACHSRTY=$EXTRACT($PIECE(ACHSUFLS(ACHSI),U,3))
SET ACHSCMP=$PIECE(^ACHSHVLG(ACHSVPT,1,ACHSK,0),U,2)
+4 IF ACHSRTY=ACHSCMP
USE ACHSHMD
WRITE *7,!,"REPORT ALREADY ON FILE FOR THIS DATE - SKIPPING ",$PIECE($PIECE(ACHSUFLS(ACHSI),U,1)," ",1),!
SET ACHSDFLG=ACHSDFLG+1
+5 GOTO DREPCK1
+6 ;
DREPCKZ ;
+1 IF ACHSDFLG=0
DO DICN
+2 GOTO FILDELB0
+3 ;
FILDELC ;
+1 SET (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV,ACHSV)=0
FILDELC0 ;
+1 SET ACHSV=$ORDER(ACHSUFLS("C",ACHSV))
+2 IF +ACHSV=0
GOTO FILDELF
FILDELC1 ;
+1 SET ACHSR=$ORDER(ACHSUFLS("C",ACHSV,ACHSR))
+2 IF +ACHSR=0
GOTO FILDELC0
FILDELC2 ;
+1 SET ACHSRR=$ORDER(ACHSUFLS("C",ACHSV,ACHSR,ACHSRR))
+2 IF +ACHSRR=0
GOTO FILDELC1
+3 IF ACHSR'=ACHSDSAV
SET ACHSCNT=ACHSCNT+1
SET ACHSDSAV=ACHSR
+4 SET ACHSCNT=ACHSCNT+1
+5 IF ACHSCNT=5
SET ACHSDELD=9999999-ACHSR
+6 GOTO FILDELC2
+7 ;
FILDELF ;
+1 IF +ACHSDELD<5
GOTO FILDEND
FILDELG ;
+1 USE ACHSHMD
+2 WRITE !
+3 KILL DIR
+4 SET DIR(0)="Y"
SET DIR("A")="Delete ALL Vendor Note. Reports with DOS BEFORE "_$$FMTE^XLFDT(ACHSDELD)
SET DIR("B")="Y"
+5 DO ^DIR
+6 KILL DIR
+7 IF Y=1
GOTO FILDELK
+8 GOTO FILDEND
+9 ;
FILDELK ;
+1 SET ACHSR=9999999-ACHSDELD
FILDELK1 ;
+1 SET ACHSR=$ORDER(ACHSUFLS("C",ACHSR))
+2 IF +ACHSR=0
GOTO FILDEND
+3 SET ACHSRR=""
SET ACHSRR=$ORDER(ACHSUFLS("C",ACHSR,ACHSRR))
+4 IF +ACHSRR=0
GOTO FILDELK1
+5 SET ACHSZFN=$PIECE($PIECE(ACHSUFLS(ACHSRR),U)," ")
+6 IF '$$DEL^%ZISH($$AOP^ACHS(2,1),ACHSZFN)
USE ACHSHMD
WRITE !!?10,ACHSZFN," has been DELETED"
KILL ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
+7 GOTO FILDELK1
+8 ;
FILDEND ;
+1 QUIT
+2 ;
ABEND ;EP
+1 USE ACHSHMD
+2 WRITE *7,!!?10,"JOB ENDED WITH ERROR(S) - NOTIFY SUPERVISOR",!
+3 DO RTRN^ACHS
+4 QUIT
+5 ;
DICN ;
+1 SET DIC="^ACHSHVLG("_ACHSVPT_",1,"
SET DIC(0)="ZML"
SET X=ACHSDATE
SET DA(1)=ACHSVPT
+2 KILL DO,DD
DO FILE^DICN
+3 SET ACHSRTY=$EXTRACT($PIECE(ACHSUFLS(ACHSI),U,3))
SET ACHSCNT=$PIECE(ACHSUFLS(ACHSI),U,4)
SET ACHSVPT=$PIECE(ACHSUFLS(ACHSI),U,5)
+4 SET $PIECE(^ACHSHVLG(ACHSVPT,1,+Y,0),U,2)=ACHSRTY
SET $PIECE(^ACHSHVLG(ACHSVPT,1,+Y,0),U,3)=ACHSCNT
SET $PIECE(^ACHSHVLG(ACHSVPT,1,+Y,0),U,4)=$PIECE($PIECE(ACHSUFLS(ACHSI),U)," ")
+5 QUIT
+6 ;
