- 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 Jan 18, 2025@03:45:59 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 ;