SD5371PT.m

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 ---SD5371PT   2465     printed  Mar 13, 2025@21:50:19                                                                                                                                                                                                    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