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

SD53198P.m

Go to the documentation of this file. 
  1. SD53198P ;BP-CIOFO/NDH - POST INSTALL SD*5.3*198 ; 20 Aug 99  09:00 AM
  1.  ;;5.3;Scheduling;**198**;Aug 13 1993
  1.  ;
  1. SEED ;Seed NPCD ENCOUNTER MONTH multiple (#404.9171) of the SCHEDULING
  1.  ; PARAMETER file (#404.91) with workload close-out dates for FY2000
  1.  ;
  1.  ;Declare variables
  1.  N XPDIDTOT,LINE,DATES,WLMONTH,DBCLOSE,WLCLOSE,TMP
  1.  ;Print header
  1.  D BMES^XPDUTL(">>> Storing revised close-out dates for Fiscal Year 1999")
  1.  S TMP=$$INSERT^SCDXUTL1("Workload","",7)
  1.  S TMP=$$INSERT^SCDXUTL1("Database",TMP,27)
  1.  S TMP=$$INSERT^SCDXUTL1("Workload",TMP,47)
  1.  D BMES^XPDUTL(TMP)
  1.  S TMP=$$INSERT^SCDXUTL1("Occured In","",6)
  1.  S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,27)
  1.  S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,47)
  1.  D MES^XPDUTL(TMP)
  1.  S TMP=$$INSERT^SCDXUTL1("------------","",5)
  1.  S TMP=$$INSERT^SCDXUTL1("------------",TMP,25)
  1.  S TMP=$$INSERT^SCDXUTL1("------------",TMP,45)
  1.  D MES^XPDUTL(TMP)
  1.  ;Loop through list of dates
  1.  S XPDIDTOT=6
  1.  F LINE=2:1:7 S TMP=$T(FY99+LINE),DATES=$P(TMP,";",3) Q:(DATES="")  D
  1.  .;Break out info
  1.  .S WLMONTH=$P(DATES,"^",1)
  1.  .S DBCLOSE=$P(DATES,"^",2)
  1.  .S WLCLOSE=$P(DATES,"^",3)
  1.  .;Print close-out info
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLMONTH,"1D"),"",7)
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(DBCLOSE,"1D"),TMP,25)
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLCLOSE,"1D"),TMP,45)
  1.  .D MES^XPDUTL(TMP)
  1.  .;Store close-out info
  1.  .S TMP=$$AECLOSE^SCDXFU04(WLMONTH,DBCLOSE,WLCLOSE)
  1.  .;Write error message if datebase or workload dates not updated
  1.  .I TMP<0 D MES^XPDUTL("       >>>>Could not update closeout dates for above month.")
  1.  .;If KIDS install, show progress through status bar
  1.  .D:($G(XPDNM)'="") UPDATE^XPDID(LINE-1)
  1.  D BMES^XPDUTL("")
  1.  ;Print header
  1.  D BMES^XPDUTL(">>> Storing close-out dates for Fiscal Year 2000")
  1.  S TMP=$$INSERT^SCDXUTL1("Workload","",7)
  1.  S TMP=$$INSERT^SCDXUTL1("Database",TMP,27)
  1.  S TMP=$$INSERT^SCDXUTL1("Workload",TMP,47)
  1.  D BMES^XPDUTL(TMP)
  1.  S TMP=$$INSERT^SCDXUTL1("Occured In","",6)
  1.  S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,27)
  1.  S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,47)
  1.  D MES^XPDUTL(TMP)
  1.  S TMP=$$INSERT^SCDXUTL1("------------","",5)
  1.  S TMP=$$INSERT^SCDXUTL1("------------",TMP,25)
  1.  S TMP=$$INSERT^SCDXUTL1("------------",TMP,45)
  1.  D MES^XPDUTL(TMP)
  1.  ;Loop through list of dates
  1.  S XPDIDTOT=12
  1.  F LINE=2:1:13 S TMP=$T(FY00+LINE),DATES=$P(TMP,";",3) Q:(DATES="")  D
  1.  .;Break out info
  1.  .S WLMONTH=$P(DATES,"^",1)
  1.  .S DBCLOSE=$P(DATES,"^",2)
  1.  .S WLCLOSE=$P(DATES,"^",3)
  1.  .;Print close-out info
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLMONTH,"1D"),"",7)
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(DBCLOSE,"1D"),TMP,25)
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLCLOSE,"1D"),TMP,45)
  1.  .D MES^XPDUTL(TMP)
  1.  .;Store close-out info
  1.  .S TMP=$$AECLOSE^SCDXFU04(WLMONTH,DBCLOSE,WLCLOSE)
  1.  .;Write error message if datebase or workload dates not updated
  1.  .I TMP<0 D MES^XPDUTL("       >>>>Could not update closeout dates for above month.")
  1.  .;If KIDS install, show progress through status bar
  1.  .D:($G(XPDNM)'="") UPDATE^XPDID(LINE-1)
  1.  D BMES^XPDUTL("")
  1.  Q
  1.  ;
  1. FY99 ;Revised Close-out dates for fiscal year 2000
  1.  ;  Month ^ Database Close-Out ^ Workload Close-Out
  1.  ;;2981000^2991015^2981106
  1.  ;;2981100^2991015^2981211
  1.  ;;2981200^2991015^2990108
  1.  ;;2990100^2991015^2990212
  1.  ;;2990200^2991015^2990312
  1.  ;;2990300^2991015^2990409
  1.  ;
  1. FY00 ;Revised Close-out dates for fiscal year 2000
  1.  ;  Month ^ Database Close-Out ^ Workload Close-Out
  1.  ;;2991000^3000414^2991112
  1.  ;;2991100^3000414^2991210
  1.  ;;2991200^3000414^3000107
  1.  ;;3000100^3000414^3000211
  1.  ;;3000200^3000414^3000310
  1.  ;;3000300^3000414^3000407
  1.  ;;3000400^3001013^3000512
  1.  ;;3000500^3001013^3000609
  1.  ;;3000600^3001013^3000707
  1.  ;;3000700^3001013^3000811
  1.  ;;3000800^3001013^3000908
  1.  ;;3000900^3001013^3001006
  1.  ;
  1.  Q  ; End Part One - 
  1.  ; Mark unsent FY1999 Q1 & Q2 NPCDB activity for transmission
  1. EN I DT>2991015 W !!,$C(7),"It is too late to run this utility!" Q
  1.  S SDSTAT=$O(^SD(409.63,"B","CHECKED OUT",0)) I 'SDSTAT W !!,"CHECKED OUT encounter status could not be identified!" K SDSTAT Q
  1.  N ZTSAVE S ZTSAVE("SDSTAT")="",ZTSAVE("SDFORCE")=""
  1.  W ! D EN^XUTMDEVQ("START^SD53198P","Re-flag NPCDB activity",.ZTSAVE) Q
  1.  ;
  1. START ;Search for activity to re-flag for transmission
  1.  K ^TMP("SD198",$J)
  1.  S SDLINE="",$P(SDLINE,"-",(IOM+1))=""
  1.  S SDTIT="<*>  RE-FLAG UNSENT FY1999 Q1 & Q2 NPCDB ACTIVITY FOR TRANSMISSION  <*>"
  1.  S SDPAGE=1 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=Y
  1.  S SDDT=2981000
  1.  F  S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>2990399)  S SDOE=0 F  S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE  D
  1.  .S SDOE0=$G(^SCE(SDOE,0)) Q:'$L(SDOE0)
  1.  .I $P(SDOE0,U),$P(SDOE0,U,2),$P(SDOE0,U,4),$P(SDOE0,U,12)=SDSTAT,'$P(SDOE0,U,6),"2^3^6"[$P($$STX^SCRPW8(SDOE,SDOE0),U) D
  1.  ..S ^TMP("SD198",$J,SDOE)=SDOE0
  1.  ..Q
  1.  .Q
  1.  S (SDOE,SDCT)=0 F  S SDOE=$O(^TMP("SD198",$J,SDOE)) Q:'SDOE  S SDCT=SDCT+1
  1.  ;
  1.  ;Too many to send!
  1.  I '$G(SDFORCE),SDCT>3000 D  G EXIT
  1.  .D HDR N C S C=(IOM-80\2) S:C<0 C=0
  1.  .W !!?(C),"This process found ",SDCT," encounters that appear not to have been",!?(C),"transmitted.  This may be due to transmission data being purgedat this site"
  1.  .W !?(C),"through the use of the 'Purge Ambulatory Care Reporting files' [SCDX AMBCAR",!?(C),"PURGE ACRP FILES] option.",!!?(C),"If the purge has beenperformed for this date range, there is no way to"
  1.  .W !?(C),"identify encounters that were not transmitted due to the workload closeout",!?(C),"date.",!!?(C),"If this count exceeds 3000 and you do notbelieve that the purge has been"
  1.  .W !?(C),"performed at your site, please contact National VistA Support (NVS) for",!?(C),"assistance in retransmitting the encounters at your site."
  1.  .Q
  1.  ;
  1.  ;Re-flag encounters for transmission
  1.  S SDOE=0 F  S SDOE=$O(^TMP("SD198",$J,SDOE)) Q:'SDOE  D
  1.  .S SDDT=+^TMP("SD198",$J,SDOE)
  1.  .S SDXP=$$CRTXMIT^SCDXFU01(SDOE,,SDDT)
  1.  .Q:SDXP'>0
  1.  .D STREEVNT^SCDXFU01(SDXP,0)
  1.  .D XMITFLAG^SCDXFU01(SDXP,0)
  1.  .Q
  1.  ;
  1.  ;Report the results
  1.  D HDR S SDTIT1="This process re-flagged "_SDCT_" encounter"_$S(SDCT=1:"",1:"s")_" for transmission." W !!?(IOM-$L(SDTIT1)\2),SDTIT1
  1.  ;
  1. EXIT K %,%H,%I,SDCT,SDDT,SDFORCE,SDLINE,SDOE,SDOE0,SDPAGE,SDPNOW,SDSTAT,SDTIT,SDTIT1,SDXP,X,Y,^TMP("SD198",$J) Q
  1.  ;
  1. FORCE ;Force the reflagging of all applicable encounters
  1.  ;
  1.  ;  CAUTION!!!  Do not use this entry point unless you are SURE that
  1.  ;              the site has not purged transmission data for this
  1.  ;              date range!
  1.  ;
  1.  S SDFORCE=1 G EN
  1.  ;
  1. HDR ;Print report header
  1.  W:SDPAGE>1 @IOF
  1.  W SDLINE,!?(IOM-$L(SDTIT)\2),SDTIT,!,SDLINE,!,"Date printed:",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q