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

SD53121.m

Go to the documentation of this file.
  1. SD53121 ;ALB/JRP - PATCH 121 POST-INIT;18-APR-97
  1. ;;5.3;Scheduling;**121**;Aug 13, 1993
  1. ;
  1. POST ;Main entry point of post-init
  1. D DELTRIG
  1. D SEED
  1. D ERRCODE
  1. D MGCHK
  1. Q
  1. ;
  1. DELTRIG ;Delete obsolete triggers on the TRANSMISSION REQUIRED field (#.04)
  1. ; of the TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
  1. ;
  1. ;Declare variables
  1. N NODE,XREFNUM,X,DIK,DA,XPDIDTOT
  1. ;Print header
  1. D BMES^XPDUTL(">>> Deleting obsolete triggers on the TRANSMISSION REQUIRED field")
  1. D MES^XPDUTL(" (#.04) of the TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73).")
  1. D MES^XPDUTL("")
  1. ;Get last x-ref number
  1. S XPDIDTOT=+$O(^DD(409.73,.04,1,""),-1)
  1. ;Loop through list of x-refs
  1. S XREFNUM=0
  1. F S XREFNUM=+$O(^DD(409.73,.04,1,XREFNUM)) Q:('XREFNUM) D
  1. .;If KIDS install, show progress through status bar
  1. .D:($G(XPDNM)'="") UPDATE^XPDID(XREFNUM)
  1. .;Grab zero node
  1. .S NODE=$G(^DD(409.73,.04,1,XREFNUM,0))
  1. .;Make sure it's a trigger x-ref
  1. .Q:($P(NODE,"^",3)'="TRIGGER")
  1. .;Make sure it triggers a field in 409.73
  1. .Q:($P(NODE,"^",4)'=409.73)
  1. .;Make sure it's one of the fields that should no longer be triggered
  1. .S X=","_(+$P(NODE,"^",5))_","
  1. .Q:(",11,12,13,14,15,"'[X)
  1. .;Obsolete triggers delete their triggered fields
  1. .Q:($G(^DD(409.73,.04,1,XREFNUM,"CREATE VALUE"))'="@")
  1. .;Delete obsolete trigger
  1. .S DIK="^DD(409.73,.04,1,"
  1. .S DA(2)=409.73
  1. .S DA(1)=.04
  1. .S DA=XREFNUM
  1. .D ^DIK
  1. .S X=" Trigger cross reference number "_XREFNUM_" deleted"
  1. .D MES^XPDUTL(X)
  1. D BMES^XPDUTL("")
  1. Q
  1. ;
  1. ERRCODE ;Update ERROR CODE DESCRIPTION field (#11) of the TRANSMITTED
  1. ; OUTPATIENT ENCOUNTER ERROR CODE file (#409.76) for error codes
  1. ; 420 & 105 (AAC changed descriptions to reflect receipt of info
  1. ; past close-out)
  1. ;
  1. ;Declare variables
  1. N SD53FDA,SD53IEN,SD53MSG
  1. ;Print info
  1. D BMES^XPDUTL(">>> Updating the ERROR CODE DESCRIPTION field (#11) of")
  1. D MES^XPDUTL(" the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file")
  1. D MES^XPDUTL(" (#409.76) for error codes 420 and 105. Definitions")
  1. D MES^XPDUTL(" were modified to reflect receipt of data by NPCD")
  1. D MES^XPDUTL(" after close-out.")
  1. D MES^XPDUTL("")
  1. ;Set up call to FileMan Updater (call will find/create entry)
  1. S SD53FDA(409.76,"?+1,",.01)=420
  1. S SD53FDA(409.76,"?+1,",11)="Date of Encounter is invalid, after date of transmission, or after close-out."
  1. S SD53FDA(409.76,"?+2,",.01)=105
  1. S SD53FDA(409.76,"?+2,",11)="Event Date is missing, invalid, after processing date, or after close-out."
  1. ;Call FileMan Updater
  1. D UPDATE^DIE("ES","SD53FDA","SD53IEN","SD53MSG")
  1. ;Error
  1. I ($D(SD53MSG("DIERR"))) D
  1. .N SD53TMP
  1. .D BMES^XPDUTL(" *** The following error occurred while updating descriptions ***")
  1. .D MSG^DIALOG("ASE",.SD53TMP,70,5,"SD53MSG")
  1. .D MES^XPDUTL("")
  1. .D MES^XPDUTL(.SD53TMP)
  1. D BMES^XPDUTL("")
  1. Q
  1. ;
  1. MGCHK ;Check to see if the LATE ACTIVITY MAIL GROUP field (#217) of the
  1. ; MAS PARAMETERS file (#43) contains a valid mail group
  1. ;
  1. ;Declare variables
  1. N NODE,XMDUZ,XMY,OK
  1. S OK=1
  1. ;Print header
  1. D BMES^XPDUTL(">>> Checking for existance of a valid mail group in the")
  1. D MES^XPDUTL(" LATE ACTIVITY MAIL GROUP field (#217) of the MAS")
  1. D MES^XPDUTL(" PARAMETERS file (#43). Members of this mail group")
  1. D MES^XPDUTL(" will be notified of all late National Patient Care")
  1. D MES^XPDUTL(" Database activity.")
  1. D MES^XPDUTL("")
  1. ;Get pointer to mail group
  1. S NODE=$G(^DG(43,1,"SCLR"))
  1. S:('$P(NODE,"^",17)) OK=0
  1. ;Use call that builds XMY() - will validate pointer (also sets XMDUZ)
  1. I (OK) D XMY^SDUTL2($P(NODE,"^",17),0,0) S:('$D(XMY)) OK=0
  1. ;Valid mail group
  1. I (OK) D
  1. .S XMDUZ=$O(XMY(""))
  1. .D BMES^XPDUTL(" Late NPCD activity will be delivered to members of")
  1. .D MES^XPDUTL(" the "_$P(XMDUZ,".",2)_" mail group")
  1. ;Valid mail group not found
  1. I ('OK) D
  1. .D BMES^XPDUTL(" *** Valid mail group not found")
  1. .D BMES^XPDUTL(" *** Notification of late NPCD activity will not occur")
  1. .D BMES^XPDUTL(" *** Use the Scheduling Parameters option [SD PARM PARAMETERS]")
  1. .D MES^XPDUTL(" to select a mail group that will receive the notifications")
  1. D BMES^XPDUTL("")
  1. Q
  1. ;
  1. SEED ;Seed NPCD ENCOUNTER MONTH multiple (#404.9171) of the SCHEDULING
  1. ; PARAMETER file (#404.91) with close-out dates for fiscal year 1997
  1. ;
  1. ;Declare variables
  1. N XPDIDTOT,LINE,DATES,WLMONTH,DBCLOSE,WLCLOSE,TMP
  1. ;Print header
  1. D BMES^XPDUTL(">>> Storing close-out dates for Fiscal Year 1997")
  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(FY97+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. .;If KIDS install, show progress through status bar
  1. .D:($G(XPDNM)'="") UPDATE^XPDID(LINE-1)
  1. D BMES^XPDUTL("")
  1. Q
  1. ;
  1. FY97 ;Close-out dates for fiscal year 1997
  1. ; Month ^ Database Close-Out ^ Workload Close-Out
  1. ;;2961000^2970430^2970331
  1. ;;2961100^2970430^2970331
  1. ;;2961200^2970430^2970331
  1. ;;2970100^2970430^2970331
  1. ;;2970200^2970430^2970331
  1. ;;2970300^2970430^2970430
  1. ;;2970400^2971031^2970531
  1. ;;2970500^2971031^2970630
  1. ;;2970600^2971031^2970731
  1. ;;2970700^2971031^2970831
  1. ;;2970800^2971031^2970930
  1. ;;2970900^2971031^2971031
  1. ;