Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSHVR2

ACHSHVR2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. FILDELB ;EP
  1.  S ACHSI=""
  1. FILDELB0 ;
  1.  S ACHSI=$O(ACHSUFLS(ACHSI))
  1.  G FILDELC:+ACHSI=0
  1. FILDELB1 ;
  1.  S Y=$P(ACHSUFLS(ACHSI),U,5),ACHSDATE=$P(ACHSUFLS(ACHSI),U,2)
  1.  G:Y=""!(ACHSDATE="") FILDELB0
  1.  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
  1.  S ACHSVPT=+Y
  1.  I '$D(^ACHSHVLG(ACHSVPT,1,0)) S ^ACHSHVLG(ACHSVPT,1,0)=$$ZEROTH^ACHS(9002078,1)
  1.  I '$D(^ACHSHVLG(ACHSVPT,1,"B",ACHSDATE)) D DICN G FILDELB0
  1. DREPCK ;
  1.  S (ACHSK,ACHSDFLG)=0
  1. DREPCK1 ;
  1.  S ACHSK=$O(^ACHSHVLG(ACHSVPT,1,"B",ACHSDATE,ACHSK))
  1.  G DREPCKZ:+ACHSK=0
  1.  S ACHSRTY=$E($P(ACHSUFLS(ACHSI),U,3)),ACHSCMP=$P(^ACHSHVLG(ACHSVPT,1,ACHSK,0),U,2)
  1.  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
  1.  G DREPCK1
  1.  ;
  1. DREPCKZ ;
  1.  I ACHSDFLG=0 D DICN
  1.  G FILDELB0
  1.  ;
  1. FILDELC ;
  1.  S (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV,ACHSV)=0
  1. FILDELC0 ;
  1.  S ACHSV=$O(ACHSUFLS("C",ACHSV))
  1.  G FILDELF:+ACHSV=0
  1. FILDELC1 ;
  1.  S ACHSR=$O(ACHSUFLS("C",ACHSV,ACHSR))
  1.  G FILDELC0:+ACHSR=0
  1. FILDELC2 ;
  1.  S ACHSRR=$O(ACHSUFLS("C",ACHSV,ACHSR,ACHSRR))
  1.  G FILDELC1:+ACHSRR=0
  1.  I ACHSR'=ACHSDSAV S ACHSCNT=ACHSCNT+1,ACHSDSAV=ACHSR
  1.  S ACHSCNT=ACHSCNT+1
  1.  I ACHSCNT=5 S ACHSDELD=9999999-ACHSR
  1.  G FILDELC2
  1.  ;
  1. FILDELF ;
  1.  G FILDEND:+ACHSDELD<5
  1. FILDELG ;
  1.  U ACHSHMD
  1.  W !
  1.  K DIR
  1.  S DIR(0)="Y",DIR("A")="Delete ALL Vendor Note. Reports with DOS BEFORE "_$$FMTE^XLFDT(ACHSDELD),DIR("B")="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y=1 G FILDELK
  1.  G FILDEND
  1.  ;
  1. FILDELK ;
  1.  S ACHSR=9999999-ACHSDELD
  1. FILDELK1 ;
  1.  S ACHSR=$O(ACHSUFLS("C",ACHSR))
  1.  G FILDEND:+ACHSR=0
  1.  S ACHSRR="",ACHSRR=$O(ACHSUFLS("C",ACHSR,ACHSRR))
  1.  G FILDELK1:+ACHSRR=0
  1.  S ACHSZFN=$P($P(ACHSUFLS(ACHSRR),U)," ")
  1.  I '$$DEL^%ZISH($$AOP^ACHS(2,1),ACHSZFN) U ACHSHMD W !!?10,ACHSZFN,"  has been DELETED" K ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
  1.  G FILDELK1
  1.  ;
  1. FILDEND ;
  1.  Q
  1.  ;
  1. ABEND ;EP
  1.  U ACHSHMD
  1.  W *7,!!?10,"JOB ENDED WITH ERROR(S) - NOTIFY SUPERVISOR",!
  1.  D RTRN^ACHS
  1.  Q
  1.  ;
  1. DICN ;
  1.  S DIC="^ACHSHVLG("_ACHSVPT_",1,",DIC(0)="ZML",X=ACHSDATE,DA(1)=ACHSVPT
  1.  K DO,DD D FILE^DICN
  1.  S ACHSRTY=$E($P(ACHSUFLS(ACHSI),U,3)),ACHSCNT=$P(ACHSUFLS(ACHSI),U,4),ACHSVPT=$P(ACHSUFLS(ACHSI),U,5)
  1.  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)," ")
  1.  Q
  1.  ;