- SD5357PT ;ALB/REW - SD*5.3*57 Post-init Checker ; 7 Aug 1996
- ;;5.3;Scheduling;**57**;SEP 25, 1993
- EN ;entry point
- ;look through HOSPITAL LOCATION File (#44) to find any active
- ;clinics without a stop code
- N SCCL,SCST,SCNM,SCNODE
- K ^TMP($J,"SC CLEANUP")
- D INTRO
- D SEARCH
- D PRINT
- D EXIT
- Q
- ;
- INTRO ;header info for output
- D MES^XPDUTL(" Any clinic record in the HOSPITAL LOCATION File (#44)")
- D MES^XPDUTL(" without a STOP CODE field (#8) will cause errors if used.")
- D BMES^XPDUTL(" *** Clinics should be created/updated via the Set up a Clinic option.")
- Q
- ;
- SEARCH ;look for active clinics without active stop codes
- N SCCL,SC44NODE,SCST,SCNM,SCSTIN
- ; SCCL - ptr to #44
- ; SC44NODE - zero node of #44
- ; SCST - ptr to 40.7 (not amis stop code)
- ; SCNM - name of clinic
- ; SCIN - clinic inactivation node: inactivation date^reactivation date
- ; SCSTND - 0 node of #40.7 (stop code)
- S SCCL=0
- D BMES^XPDUTL(">>>Searching HOSPITAL LOCATION File...")
- F S SCCL=$O(^SC("AC","C",SCCL)) Q:'SCCL D
- .N SCIN,SCRE
- .S SCIN=$G(^SC(SCCL,"I"))
- .;quit if inactivate date exists & is before today & not reactive now
- .Q:$S('SCIN:0,(SCIN>DT):0,('$P(SCIN,U,2)):1,($P(SCIN,U,2)<DT):0,1:1)
- .S SC44NODE=$G(^SC(SCCL,0)),SCST=$P(SC44NODE,U,7),SCNM=$P(SC44NODE,U,1)
- .IF 'SCST D
- ..;for no stop code
- ..S ^TMP($J,"SC CLEANUP","B",SCNM,SCCL)=SCNM_" [#"_SCCL_"]"
- .ELSE D
- ..S SCSTND=$G(^DIC(40.7,SCST,0))
- ..;if stopcode inactive date exists and is before today
- ..S:$P(SCSTND,U,3)&($P(SCSTND,U,3)<DT) ^TMP($J,"SC CLEANUP","B",SCNM,SCCL)=SCNM_" [#"_SCCL_"] -- inactive STOP CODE: "_$P(SCSTND,U,1)_" ("_$P(SCSTND,U,2)_")"
- Q
- ;
- PRINT ;display clinics with stop code problems
- N SCNM,SCCL,SCTMPND
- D BMES^XPDUTL("The following are ACTIVE clinics without an active STOP CODE field:")
- IF '$D(^TMP($J,"SC CLEANUP")) D
- .D MES^XPDUTL(" All active clinics have an active STOP CODE field.")
- .D MES^XPDUTL(" No further action is required.")
- S SCNM=""
- F S SCNM=$O(^TMP($J,"SC CLEANUP","B",SCNM)) Q:SCNM="" D
- .S SCCL=0
- .F S SCCL=$O(^TMP($J,"SC CLEANUP","B",SCNM,SCCL)) Q:'SCCL S SCTMPND=$G(^(SCCL)) D
- ..D MES^XPDUTL(SCTMPND)
- Q
- ;
- EXIT ;final cleanup
- K ^TMP($J,"SC CLEANUP")
- D BMES^XPDUTL("This post-install output is saved in the INSTALL File (#9.7)")
- D MES^XPDUTL("under 'SD*5.3*57'")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5357PT 2378 printed Apr 23, 2025@18:59:45 Page 2
- SD5357PT ;ALB/REW - SD*5.3*57 Post-init Checker ; 7 Aug 1996
- +1 ;;5.3;Scheduling;**57**;SEP 25, 1993
- EN ;entry point
- +1 ;look through HOSPITAL LOCATION File (#44) to find any active
- +2 ;clinics without a stop code
- +3 NEW SCCL,SCST,SCNM,SCNODE
- +4 KILL ^TMP($JOB,"SC CLEANUP")
- +5 DO INTRO
- +6 DO SEARCH
- +7 DO PRINT
- +8 DO EXIT
- +9 QUIT
- +10 ;
- INTRO ;header info for output
- +1 DO MES^XPDUTL(" Any clinic record in the HOSPITAL LOCATION File (#44)")
- +2 DO MES^XPDUTL(" without a STOP CODE field (#8) will cause errors if used.")
- +3 DO BMES^XPDUTL(" *** Clinics should be created/updated via the Set up a Clinic option.")
- +4 QUIT
- +5 ;
- SEARCH ;look for active clinics without active stop codes
- +1 NEW SCCL,SC44NODE,SCST,SCNM,SCSTIN
- +2 ; SCCL - ptr to #44
- +3 ; SC44NODE - zero node of #44
- +4 ; SCST - ptr to 40.7 (not amis stop code)
- +5 ; SCNM - name of clinic
- +6 ; SCIN - clinic inactivation node: inactivation date^reactivation date
- +7 ; SCSTND - 0 node of #40.7 (stop code)
- +8 SET SCCL=0
- +9 DO BMES^XPDUTL(">>>Searching HOSPITAL LOCATION File...")
- +10 FOR
- SET SCCL=$ORDER(^SC("AC","C",SCCL))
- if 'SCCL
- QUIT
- Begin DoDot:1
- +11 NEW SCIN,SCRE
- +12 SET SCIN=$GET(^SC(SCCL,"I"))
- +13 ;quit if inactivate date exists & is before today & not reactive now
- +14 if $SELECT('SCIN
- QUIT
- +15 SET SC44NODE=$GET(^SC(SCCL,0))
- SET SCST=$PIECE(SC44NODE,U,7)
- SET SCNM=$PIECE(SC44NODE,U,1)
- +16 IF 'SCST
- Begin DoDot:2
- +17 ;for no stop code
- +18 SET ^TMP($JOB,"SC CLEANUP","B",SCNM,SCCL)=SCNM_" [#"_SCCL_"]"
- End DoDot:2
- +19 IF '$TEST
- Begin DoDot:2
- +20 SET SCSTND=$GET(^DIC(40.7,SCST,0))
- +21 ;if stopcode inactive date exists and is before today
- +22 if $PIECE(SCSTND,U,3)&($PIECE(SCSTND,U,3)<DT)
- SET ^TMP($JOB,"SC CLEANUP","B",SCNM,SCCL)=SCNM_" [#"_SCCL_"] -- inactive STOP CODE: "_$PIECE(SCSTND,U,1)_" ("_$PIECE(SCSTND,U,2)_")"
- End DoDot:2
- End DoDot:1
- +23 QUIT
- +24 ;
- PRINT ;display clinics with stop code problems
- +1 NEW SCNM,SCCL,SCTMPND
- +2 DO BMES^XPDUTL("The following are ACTIVE clinics without an active STOP CODE field:")
- +3 IF '$DATA(^TMP($JOB,"SC CLEANUP"))
- Begin DoDot:1
- +4 DO MES^XPDUTL(" All active clinics have an active STOP CODE field.")
- +5 DO MES^XPDUTL(" No further action is required.")
- End DoDot:1
- +6 SET SCNM=""
- +7 FOR
- SET SCNM=$ORDER(^TMP($JOB,"SC CLEANUP","B",SCNM))
- if SCNM=""
- QUIT
- Begin DoDot:1
- +8 SET SCCL=0
- +9 FOR
- SET SCCL=$ORDER(^TMP($JOB,"SC CLEANUP","B",SCNM,SCCL))
- if 'SCCL
- QUIT
- SET SCTMPND=$GET(^(SCCL))
- Begin DoDot:2
- +10 DO MES^XPDUTL(SCTMPND)
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;
- EXIT ;final cleanup
- +1 KILL ^TMP($JOB,"SC CLEANUP")
- +2 DO BMES^XPDUTL("This post-install output is saved in the INSTALL File (#9.7)")
- +3 DO MES^XPDUTL("under 'SD*5.3*57'")
- +4 QUIT
