Routine: GMRCYP50

GMRCYP50 ;ISP/TDP - POST INSTALL FOR GMRC*3*50 ; 5/2/2006

 ;;3.0;CONSULT/REQUEST TRACKING;**50**;DEC 27, 1997;Build 8

POST ; Start of Pre-init for patch GMRC*3*50

 N GMRCTTL

 K ^TMP("GMRCYP50",$J)

 D BMES^XPDUTL("Starting Post-init...")

 D BMES^XPDUTL("   Searching for Procedure Consults which have an Inter-Facility")

 D MES^XPDUTL("   Consult as a Related Service.")

 D MES^XPDUTL(" ")

 D SEARCH

 I GMRCTTL D MSG

 I 'GMRCTTL D BMES^XPDUTL("      No invalid entries found.")

 D BMES^XPDUTL("Post-init complete.")

SEARCH ; Search RELATED SERVICES (#2) field of the GMRC PROCEDURE (#123.3) file

 ; for invalid IFC services.

 N GMRCMSG,GMRCMSG1,GMRCPIEN,GMRCPRC,GMRCSIEN,GMRCSVC,X,XX,Y

 S (GMRCPRC,GMRCTTL)=0

 F  S GMRCPRC=$O(^GMR(123.3,"B",GMRCPRC)) Q:GMRCPRC=""  D

 . S GMRCPIEN=""

 . F  S GMRCPIEN=$O(^GMR(123.3,"B",GMRCPRC,GMRCPIEN)) Q:GMRCPIEN=""  D

 .. S GMRCSIEN=0

 .. F  S GMRCSIEN=$O(^GMR(123.3,GMRCPIEN,2,"B",GMRCSIEN)) Q:GMRCSIEN=""  D

 ... I '+$G(^GMR(123.5,+GMRCSIEN,"IFC")),'+$O(^GMR(123.5,+GMRCSIEN,"IFCS",0)) Q

 ... S GMRCSVC=$P($G(^GMR(123.5,GMRCSIEN,0)),U,1)

 ... I GMRCSVC="" S GMRCSVC="SERVICE UNKNOWN"

 ... S ^TMP("GMRCYP50",$J,GMRCPRC_" (#"_GMRCPIEN_")",GMRCSVC_" (#"_GMRCSIEN_")")=""

 ... K GMRCMSG

 ... S GMRCMSG="Related Service, "_GMRCSVC_" (IEN #"_GMRCSIEN_"), associated with Consult Procedure, "_GMRCPRC_" (IEN #"_GMRCPIEN_"), is an Inter-Facility Consult Service and must be removed or replaced with a service which is not an IFC!"

 ... S Y=0

 ... F X=1:1 S GMRCMSG1=$E(GMRCMSG,Y,Y+61) D  Q:Y'<$L(GMRCMSG)

 .... I $L(GMRCMSG1)<61 S Y=Y+61,GMRCMSG(X)=GMRCMSG1 Q

 .... F XX=61:-1:1 D  Q:$D(GMRCMSG(X))

 ..... I $E(GMRCMSG1,XX)'=" " Q

 ..... S Y=Y+1+XX I X>1 S Y=Y-1

 ..... S GMRCMSG(X)=$E(GMRCMSG1,1,XX)

 ... S X=""

 ... F  S X=$O(GMRCMSG(X)) Q:X=""  W !,"      "_$G(GMRCMSG(X))

 ... W !

 ... S GMRCTTL=GMRCTTL+1

 ;D MES^XPDUTL(" ")

 D BMES^XPDUTL("   "_GMRCTTL_" total invalid Related Services.")

MSG ; Send Mailman message to installer

 N GMRCC,GMRCCNT,GMRCPARM,GMRCPRC,GMRCSVC,GMRCTXT,GMRCWHO

 N XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y

 S XMSUB="RELATED SERVICES ARE INVALID"

 I DUZ="" N DUZ S DUZ=.5 ; if user not defined set to postmaster

 S XMDUZ=DUZ,XMTEXT="GMRCTXT"

 S GMRCPARM("FROM")="PATCH GMRC*3.0*50 POST-INIT"

 S XMY(DUZ)="" ; send message to user

 S GMRCC=0

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message has been sent by patch GMRC*3.0*50 at the completion of"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="the post-init routine."

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="  "

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message was sent because Consult Procedure records were found which"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="contained one or more Related Services which are setup as Inter-Facility"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Consults.  These related services should be removed and replaced with"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="non-IFC services to prevent possible problems in the Consult/Request"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Tracking package.  The following information is provided to assist you"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="in your cleanup efforts."

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="  "

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="PROCEDURE"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="     RELATED SERVICE"

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="==========================================================================="

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="  "

 S GMRCCNT=0,GMRCPRC=""

 F  S GMRCPRC=$O(^TMP("GMRCYP50",$J,GMRCPRC)) Q:GMRCPRC=""  D

 . S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=GMRCPRC

 . S GMRCSVC=""

 . F  S GMRCSVC=$O(^TMP("GMRCYP50",$J,GMRCPRC,GMRCSVC)) Q:GMRCSVC=""  D

 .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="    "_GMRCSVC

 .. S GMRCCNT=GMRCCNT+1

 . S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="  "

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="  "

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="  "

 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total invalid Related Services: "_GMRCCNT

 D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")

 S GMRCMSG(1)=" "

 S GMRCMSG(2)="******************************************************************************"

 S GMRCMSG(3)="** Message containing Procedure Consult records which have invalid          **"

 S GMRCMSG(4)="** Related Services was "_$S($D(XMERR):"not sent due to an error in the message set up.       **",1:"sent to the "_$S(DUZ=.5:"postmaster.  Please forward this         **",1:"user.  Please forward this              **"))

 I $D(XMERR) S GMRCMSG(5)="** Dumping message to screen.                                               **"

 I '$D(XMERR) S GMRCMSG(5)="** message to the appropriate staff, which includes the clinical            **"

 I '$D(XMERR) S GMRCMSG(6)="** coordinator, for further action.                                         **"

 S GMRCMSG($S($D(XMERR):6,1:7))="******************************************************************************"

 D BMES^XPDUTL(.GMRCMSG)

 I $D(XMERR) D BMES^XPDUTL("  "),BMES^XPDUTL(.GMRCTXT)

 K ^TMP("GMRCYP50",$J)

GMRCYP50  ;ISP/TDP - POST INSTALL FOR GMRC*3*50 ; 5/2/2006

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**50**;DEC 27, 1997;Build 8

 +2        QUIT

 +3       ;

POST      ; Start of Pre-init for patch GMRC*3*50

 +1        NEW GMRCTTL

 +2        KILL ^TMP("GMRCYP50",$JOB)

 +3        DO BMES^XPDUTL("Starting Post-init...")

 +4        DO BMES^XPDUTL("   Searching for Procedure Consults which have an Inter-Facility")

 +5        DO MES^XPDUTL("   Consult as a Related Service.")

 +6        DO MES^XPDUTL(" ")

 +7        DO SEARCH

 +8        IF GMRCTTL

               DO MSG

 +9        IF 'GMRCTTL

               DO BMES^XPDUTL("      No invalid entries found.")

 +10       DO BMES^XPDUTL("Post-init complete.")

 +11       QUIT

 +12      ;

SEARCH    ; Search RELATED SERVICES (#2) field of the GMRC PROCEDURE (#123.3) file

 +1       ; for invalid IFC services.

 +2        NEW GMRCMSG,GMRCMSG1,GMRCPIEN,GMRCPRC,GMRCSIEN,GMRCSVC,X,XX,Y

 +3        SET (GMRCPRC,GMRCTTL)=0

 +4        FOR

               SET GMRCPRC=$ORDER(^GMR(123.3,"B",GMRCPRC))

               IF GMRCPRC=""

                   QUIT

               Begin DoDot:1

 +5                SET GMRCPIEN=""

 +6                FOR

                       SET GMRCPIEN=$ORDER(^GMR(123.3,"B",GMRCPRC,GMRCPIEN))

                       IF GMRCPIEN=""

                           QUIT

                       Begin DoDot:2

 +7                        SET GMRCSIEN=0

 +8                        FOR

                               SET GMRCSIEN=$ORDER(^GMR(123.3,GMRCPIEN,2,"B",GMRCSIEN))

                               IF GMRCSIEN=""

                                   QUIT

                               Begin DoDot:3

 +9                                IF '+$GET(^GMR(123.5,+GMRCSIEN,"IFC"))

                                       IF '+$ORDER(^GMR(123.5,+GMRCSIEN,"IFCS",0))

                                           QUIT

 +10                               SET GMRCSVC=$PIECE($GET(^GMR(123.5,GMRCSIEN,0)),U,1)

 +11                               IF GMRCSVC=""

                                       SET GMRCSVC="SERVICE UNKNOWN"

 +12                               SET ^TMP("GMRCYP50",$JOB,GMRCPRC_" (#"_GMRCPIEN_")",GMRCSVC_" (#"_GMRCSIEN_")")=""

 +13                               KILL GMRCMSG

 +14                               SET GMRCMSG="Related Service, "_GMRCSVC_" (IEN #"_GMRCSIEN_"), associated with Consult Procedure, "_GMRCPRC_" (IEN #"_GMRCPIEN_"), is an Inter-Facility Consult Service and must be removed or replaced with a service which

 is not an IFC!"

 +15                               SET Y=0

 +16                               FOR X=1:1

                                       SET GMRCMSG1=$EXTRACT(GMRCMSG,Y,Y+61)

                                       Begin DoDot:4

 +17                                       IF $LENGTH(GMRCMSG1)<61

                                               SET Y=Y+61

                                               SET GMRCMSG(X)=GMRCMSG1

                                               QUIT

 +18                                       FOR XX=61:-1:1

                                               Begin DoDot:5

 +19                                               IF $EXTRACT(GMRCMSG1,XX)'=" "

                                                       QUIT

 +20                                               SET Y=Y+1+XX

                                                   IF X>1

                                                       SET Y=Y-1

 +21                                               SET GMRCMSG(X)=$EXTRACT(GMRCMSG1,1,XX)

                                               End DoDot:5

                                               IF $DATA(GMRCMSG(X))

                                                   QUIT

                                       End DoDot:4

                                       IF Y'<$LENGTH(GMRCMSG)

                                           QUIT

 +22                               SET X=""

 +23                               FOR

                                       SET X=$ORDER(GMRCMSG(X))

                                       IF X=""

                                           QUIT

                                       WRITE !,"      "_$GET(GMRCMSG(X))

 +24                               WRITE !

 +25                               SET GMRCTTL=GMRCTTL+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +26      ;D MES^XPDUTL(" ")

 +27       DO BMES^XPDUTL("   "_GMRCTTL_" total invalid Related Services.")

 +28       QUIT

 +29      ;

MSG       ; Send Mailman message to installer

 +1        NEW GMRCC,GMRCCNT,GMRCPARM,GMRCPRC,GMRCSVC,GMRCTXT,GMRCWHO

 +2        NEW XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y

 +3        SET XMSUB="RELATED SERVICES ARE INVALID"

 +4       ; if user not defined set to postmaster

           IF DUZ=""

               NEW DUZ

               SET DUZ=.5

 +5        SET XMDUZ=DUZ

           SET XMTEXT="GMRCTXT"

 +6        SET GMRCPARM("FROM")="PATCH GMRC*3.0*50 POST-INIT"

 +7       ; send message to user

           SET XMY(DUZ)=""

 +8        SET GMRCC=0

 +9        SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="This message has been sent by patch GMRC*3.0*50 at the completion of"

 +10       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="the post-init routine."

 +11       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="  "

 +12       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="This message was sent because Consult Procedure records were found which"

 +13       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="contained one or more Related Services which are setup as Inter-Facility"

 +14       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="Consults.  These related services should be removed and replaced with"

 +15       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="non-IFC services to prevent possible problems in the Consult/Request"

 +16       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="Tracking package.  The following information is provided to assist you"

 +17       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="in your cleanup efforts."

 +18       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="  "

 +19       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="PROCEDURE"

 +20       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="     RELATED SERVICE"

 +21       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="==========================================================================="

 +22       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="  "

 +23       SET GMRCCNT=0

           SET GMRCPRC=""

 +24       FOR

               SET GMRCPRC=$ORDER(^TMP("GMRCYP50",$JOB,GMRCPRC))

               IF GMRCPRC=""

                   QUIT

               Begin DoDot:1

 +25               SET GMRCC=GMRCC+1

                   SET GMRCTXT(GMRCC)=GMRCPRC

 +26               SET GMRCSVC=""

 +27               FOR

                       SET GMRCSVC=$ORDER(^TMP("GMRCYP50",$JOB,GMRCPRC,GMRCSVC))

                       IF GMRCSVC=""

                           QUIT

                       Begin DoDot:2

 +28                       SET GMRCC=GMRCC+1

                           SET GMRCTXT(GMRCC)="    "_GMRCSVC

 +29                       SET GMRCCNT=GMRCCNT+1

                       End DoDot:2

 +30               SET GMRCC=GMRCC+1

                   SET GMRCTXT(GMRCC)="  "

               End DoDot:1

 +31       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="  "

 +32       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="  "

 +33       SET GMRCC=GMRCC+1

           SET GMRCTXT(GMRCC)="Total invalid Related Services: "_GMRCCNT

 +34       DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")

 +35       SET GMRCMSG(1)=" "

 +36       SET GMRCMSG(2)="******************************************************************************"

 +37       SET GMRCMSG(3)="** Message containing Procedure Consult records which have invalid          **"

 +38       SET GMRCMSG(4)="** Related Services was "_$SELECT($DATA(XMERR):"not sent due to an error in the message set up.       **",1:"sent to the "_$SELECT(DUZ=.5:"postmaster.  Please forward this         **",1:"user.  Please forward this              *

*"))

 +39       IF $DATA(XMERR)

               SET GMRCMSG(5)="** Dumping message to screen.                                               **"

 +40       IF '$DATA(XMERR)

               SET GMRCMSG(5)="** message to the appropriate staff, which includes the clinical            **"

 +41       IF '$DATA(XMERR)

               SET GMRCMSG(6)="** coordinator, for further action.                                         **"

 +42       SET GMRCMSG($SELECT($DATA(XMERR):6,1:7))="******************************************************************************"

 +43       DO BMES^XPDUTL(.GMRCMSG)

 +44       IF $DATA(XMERR)

               DO BMES^XPDUTL("  ")

               DO BMES^XPDUTL(.GMRCTXT)

 +45       KILL ^TMP("GMRCYP50",$JOB)

 +46       QUIT

GMRCYP50.m