SD5371PT ;ALB/SEK - POST-INSTALL FOR PATCH SD*5.3*71 ; 24-OCT-96
;;5.3;Scheduling;**71**;AUG 13, 1993
;
EN ; This routine will be executed upon installation of the KIDS build.
;
; This routine will loop through the active clinics ot the
; HOSPITAL LOCATION file (#44) and check providers
; (DEFAULT PROVIDER field #16 and PROVIDER field #.01 of the PROVIDER
; multiple #2600) in the NEW PERSON file (#200). If these providers
; are inactive or active with no active entry in the NEW PERSON
; file for PERSON CLASS, a list will be generated for the site.
; This PERSON CLASS check is the replacement screen for the
; provider key screen on the provider fields.
;
K ^TMP($J)
N CNT,CNT1,CNT2,CNT3,I,II,NODE,SDDP,SDINACT,SDNAMEC,SDNAMEP
S CNT=0
;
D BMES^XPDUTL("This will loop through the active clinics of the HOSPITAL LOCATION")
D MES^XPDUTL("file (#44) and check for inactive providers and for active")
D MES^XPDUTL("providers with no active entry in the NEW")
D MES^XPDUTL("PERSON file (#200) for PERSON CLASS.")
;
;
;- get IEN from HOSPITAL LOCATION file using "AC" xref
S I=0
F S I=$O(^SC("AC","C",I)) Q:'I D
.S NODE=$G(^SC(I,0)) Q:NODE']""
.;
.; check if active clinic
.S SDINACT=$G(^SC(I,"I"))
.Q:'$S(SDINACT']"":1,'+$P(SDINACT,"^"):1,DT<+$P(SDINACT,"^"):1,+$P(SDINACT,"^",2):1,1:0)
.; get DEFAULT PROVIDER
.S SDDP=$P(NODE,"^",13) I SDDP D CHECK
.;
.; get PROVIDER
.S II=0 F S II=$O(^SC(I,"PR",II)) Q:'II D
..S SDDP=+$G(^SC(I,"PR",II,0)) Q:'SDDP D CHECK
.Q
;
; print providers
D BMES^XPDUTL("You have "_CNT_" providers that are inactive or active with no active")
D MES^XPDUTL("entry in the NEW PERSON file for PERSON CLASS. The following")
D MES^XPDUTL("list contains clinic(s) provider is assigned to:")
S CNT1=0
F S CNT1=$O(^TMP($J,CNT1)) Q:CNT1']"" D
.S CNT2=0
.F S CNT2=$O(^TMP($J,CNT1,CNT2)) Q:'CNT2 D
..D MES^XPDUTL(" "_CNT1_" (IEN="_CNT2_")")
..S CNT3=0
..F S CNT3=$O(^TMP($J,CNT1,CNT2,CNT3)) Q:CNT3']"" D
...D MES^XPDUTL(" "_CNT3)
K ^TMP($J)
Q
;
CHECK ; check if provider is active and has an active entry for PERSON CLASS
Q:$$SCREEN^SDUTL2(SDDP)
;
S SDNAMEP=$P($G(^VA(200,+SDDP,0)),"^")
S SDNAMEC=$P(NODE,"^")
I '$D(^TMP($J,SDNAMEP,+SDDP)) D Q
.S ^TMP($J,SDNAMEP,SDDP)=""
.S ^TMP($J,SDNAMEP,SDDP,SDNAMEC)=""
.S CNT=CNT+1
I '$D(^TMP($J,SDNAMEP,+SDDP,SDNAMEC)) S ^TMP($J,SDNAMEP,SDDP,SDNAMEC)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5371PT 2465 printed Apr 09, 2024@21:55:58 Page 2
SD5371PT ;ALB/SEK - POST-INSTALL FOR PATCH SD*5.3*71 ; 24-OCT-96
+1 ;;5.3;Scheduling;**71**;AUG 13, 1993
+2 ;
EN ; This routine will be executed upon installation of the KIDS build.
+1 ;
+2 ; This routine will loop through the active clinics ot the
+3 ; HOSPITAL LOCATION file (#44) and check providers
+4 ; (DEFAULT PROVIDER field #16 and PROVIDER field #.01 of the PROVIDER
+5 ; multiple #2600) in the NEW PERSON file (#200). If these providers
+6 ; are inactive or active with no active entry in the NEW PERSON
+7 ; file for PERSON CLASS, a list will be generated for the site.
+8 ; This PERSON CLASS check is the replacement screen for the
+9 ; provider key screen on the provider fields.
+10 ;
+11 KILL ^TMP($JOB)
+12 NEW CNT,CNT1,CNT2,CNT3,I,II,NODE,SDDP,SDINACT,SDNAMEC,SDNAMEP
+13 SET CNT=0
+14 ;
+15 DO BMES^XPDUTL("This will loop through the active clinics of the HOSPITAL LOCATION")
+16 DO MES^XPDUTL("file (#44) and check for inactive providers and for active")
+17 DO MES^XPDUTL("providers with no active entry in the NEW")
+18 DO MES^XPDUTL("PERSON file (#200) for PERSON CLASS.")
+19 ;
+20 ;
+21 ;- get IEN from HOSPITAL LOCATION file using "AC" xref
+22 SET I=0
+23 FOR
SET I=$ORDER(^SC("AC","C",I))
if 'I
QUIT
Begin DoDot:1
+24 SET NODE=$GET(^SC(I,0))
if NODE']""
QUIT
+25 ;
+26 ; check if active clinic
+27 SET SDINACT=$GET(^SC(I,"I"))
+28 if '$SELECT(SDINACT']""
QUIT
+29 ; get DEFAULT PROVIDER
+30 SET SDDP=$PIECE(NODE,"^",13)
IF SDDP
DO CHECK
+31 ;
+32 ; get PROVIDER
+33 SET II=0
FOR
SET II=$ORDER(^SC(I,"PR",II))
if 'II
QUIT
Begin DoDot:2
+34 SET SDDP=+$GET(^SC(I,"PR",II,0))
if 'SDDP
QUIT
DO CHECK
End DoDot:2
+35 QUIT
End DoDot:1
+36 ;
+37 ; print providers
+38 DO BMES^XPDUTL("You have "_CNT_" providers that are inactive or active with no active")
+39 DO MES^XPDUTL("entry in the NEW PERSON file for PERSON CLASS. The following")
+40 DO MES^XPDUTL("list contains clinic(s) provider is assigned to:")
+41 SET CNT1=0
+42 FOR
SET CNT1=$ORDER(^TMP($JOB,CNT1))
if CNT1']""
QUIT
Begin DoDot:1
+43 SET CNT2=0
+44 FOR
SET CNT2=$ORDER(^TMP($JOB,CNT1,CNT2))
if 'CNT2
QUIT
Begin DoDot:2
+45 DO MES^XPDUTL(" "_CNT1_" (IEN="_CNT2_")")
+46 SET CNT3=0
+47 FOR
SET CNT3=$ORDER(^TMP($JOB,CNT1,CNT2,CNT3))
if CNT3']""
QUIT
Begin DoDot:3
+48 DO MES^XPDUTL(" "_CNT3)
End DoDot:3
End DoDot:2
End DoDot:1
+49 KILL ^TMP($JOB)
+50 QUIT
+51 ;
CHECK ; check if provider is active and has an active entry for PERSON CLASS
+1 if $$SCREEN^SDUTL2(SDDP)
QUIT
+2 ;
+3 SET SDNAMEP=$PIECE($GET(^VA(200,+SDDP,0)),"^")
+4 SET SDNAMEC=$PIECE(NODE,"^")
+5 IF '$DATA(^TMP($JOB,SDNAMEP,+SDDP))
Begin DoDot:1
+6 SET ^TMP($JOB,SDNAMEP,SDDP)=""
+7 SET ^TMP($JOB,SDNAMEP,SDDP,SDNAMEC)=""
+8 SET CNT=CNT+1
End DoDot:1
QUIT
+9 IF '$DATA(^TMP($JOB,SDNAMEP,+SDDP,SDNAMEC))
SET ^TMP($JOB,SDNAMEP,SDDP,SDNAMEC)=""
+10 QUIT
