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 Dec 13, 2024@02:45:15 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
