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