Routine: GMRCP50

GMRCP50 ;ISP/TDP - PRE INSTALL FOR GMRC*3*50 ; 11/29/2005

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

EN ;Entry point for manual start from programmer's prompt

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,NMFLG,X,Y

 S DIR(0)="Y"

 S DIR("A")="Print Full Patient Names on pre-install report"

 S DIR("B")="YES"

 S DIR("?")="Answer 'NO' to print patients' initials and last 6 of SSN."

 S DIR("?",1)="Answer 'YES' to print patients' full name and last 4 of SSN."

 D ^DIR I (($G(DIROUT))!($G(DIRUT))!($G(DUOUT))!($G(DTOUT))) Q

 S NMFLG=Y

PRE ;Start of Pre-init of patch GMRC*3*50

 N GMRCTTL,GMRCITL

 K ^TMP("GMRCP50",$J),^TMP("GMRCP50 IFC",$J)

 I '$D(NMFLG) N NMFLG D

 . S NMFLG=$O(XPDQUES(""))

 . S NMFLG=$G(XPDQUES(NMFLG))

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

 D BMES^XPDUTL("   Searching for ampersand (""&"") in the SIGNIFICANT FINDINGS (#15) field")

 D MES^XPDUTL("   of the REQUEST/CONSULTATION (#123) file.")

 D MES^XPDUTL(" ")

 D SEARCH

 I GMRCTTL!(GMRCITL) D MSG^GMRCP50A

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

SEARCH ;Search SIGNIFICANT FINDINGS (#15) field of the REQUEST/CONSULTATION

 ;(#123) file for ampersand ("&").

 N GMRC0,GMRC40,GMRCACT,GMRCACDT,GMRCADT,GMRCAIEN,GMRCCIEN,GMRCCOM

 N GMRCCPRS,GMRCDFN,GMRCDFN1,GMRCDONE,GMRCDT,GMRCIEN,GMRCIFC,GMRCSVC

 N GMRCSSN,GMRCSSN1,GMRCWHO

 S (GMRCDT,GMRCITL,GMRCTTL)=0

 F  S GMRCDT=$O(^GMR(123,"B",GMRCDT)) Q:GMRCDT=""  D

 . S GMRCIEN=""

 . F  S GMRCIEN=$O(^GMR(123,"B",GMRCDT,GMRCIEN)) Q:GMRCIEN=""  D

 .. S GMRCDONE=0

 .. S GMRC0=$G(^GMR(123,GMRCIEN,0)) I $P(GMRC0,U,19)'="&" Q

 .. S GMRCIFC="GMRCP50"

 .. I $P($G(^GMR(123,GMRCIEN,12)),U,5)="P" S GMRCIFC="GMRCP50 IFC"

 .. S GMRCDFN=+$P(GMRC0,U,2) S:GMRCDFN GMRCSSN=$P($G(^DPT(GMRCDFN,0)),U,9),GMRCDFN=$P($G(^DPT(GMRCDFN,0)),U,1)

 .. S GMRCSSN1="("_$E(GMRCDFN,1)_$E(GMRCSSN,6,9)_")"

 .. S GMRCDFN1=GMRCDFN

 .. I (GMRCDFN=0)!(GMRCDFN="") S GMRCDFN="PATIENT UNKNOWN"

 .. S GMRCDFN=GMRCDFN_" "_GMRCSSN1

 .. S GMRCSVC=+$P(GMRC0,U,5) S:GMRCSVC GMRCSVC=$P($G(^GMR(123.5,GMRCSVC,0)),U,1)

 .. I (GMRCSVC=0)!(GMRCSVC="") S GMRCSVC="SERVICE UNKNOWN"

 .. S GMRCCPRS=+$P(GMRC0,U,12) S:GMRCCPRS GMRCCPRS=$P($G(^ORD(100.01,GMRCCPRS,0)),U,1)

 .. I (GMRCCPRS=0)!(GMRCCPRS="") S GMRCCPRS="STATUS UNKNOWN"

 .. D ACTIVITY

 .. S ^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,0)=GMRCIEN_U_GMRCSVC_U_GMRCCPRS_U_GMRCACT_U_GMRCACDT_U_GMRCWHO

 .. I 'NMFLG D

 ... S ^TMP(GMRCIFC,$J,GMRCDFN,0)="("_$E($P(GMRCDFN1,",",2),1)_$E($P($P(GMRCDFN1,",",2)," ",2),1)_$E(GMRCDFN1,1)_$E(GMRCSSN,4,9)_")"

 .. W !,"   Consult entry "_GMRCIEN_" has an ampersand (""&"") as the Significant Finding."

 .. S GMRCTTL=GMRCTTL+1

 .. I GMRCIFC="GMRCP50 IFC" S GMRCITL=GMRCITL+1

 D MES^XPDUTL(" ")

 D BMES^XPDUTL(GMRCTTL_" total consults contain an ampersand as the Significant Finding.")

ACTIVITY ;Search thru all Request Processing Activities and return any

 ;Significant Findings or Administrative Completions.

 N GMRCSIG,GMRCFLG

 S GMRCSIG=$O(^GMR(123.1,"B","SIG FINDING UPDATE",""))

 S GMRCFLG=0

ACT1 S (GMRCACDT,GMRCACT,GMRCADT,GMRCWHO)=""

 F  S GMRCADT=$O(^GMR(123,GMRCIEN,40,"B",GMRCADT),-1) Q:GMRCADT=""  D  Q:GMRCDONE

 . S GMRCAIEN=""

 . F  S GMRCAIEN=$O(^GMR(123,GMRCIEN,40,"B",GMRCADT,GMRCAIEN)) Q:GMRCAIEN=""  D  Q:GMRCDONE

 .. S GMRC40=$G(^GMR(123,GMRCIEN,40,GMRCAIEN,0)) I $P(GMRC40,U,2)'=GMRCSIG Q

 .. S GMRCACT=+$P(GMRC40,U,2) S:GMRCACT GMRCACT=$P($G(^GMR(123.1,GMRCACT,0)),U,1)

 .. I (GMRCACT=0)!(GMRCACT="") S GMRCACT="ACTIVITY UNKNOWN"

 .. S GMRCACDT=+$P(GMRC40,U,3)

 .. S GMRCWHO=+$P(GMRC40,U,4) S:'GMRCWHO GMRCWHO=+$P(GMRC40,U,5)

 .. I 'GMRCWHO S GMRCWHO=$P($G(^GMR(123,GMRCIEN,40,GMRCAIEN,2)),U,2) S:'GMRCWHO GMRCWHO=$P($G(^GMR(123,GMRCIEN,40,GMRCAIEN,2)),U,1)

 .. S:+GMRCWHO GMRCWHO=$P($G(^VA(200,GMRCWHO,0)),U,1)

 .. I (GMRCWHO=0)!(GMRCWHO="") S GMRCWHO="RESP. PERSON UNKNOWN"

 .. D COMMENT

 .. S GMRCDONE=1

 I 'GMRCDONE,'GMRCFLG S GMRCSIG=$O(^GMR(123.1,"B","COMPLETE/UPDATE","")),GMRCFLG=1 D ACT1

COMMENT ;Gather comment for Activity

 I '$D(^GMR(123,GMRCIEN,40,GMRCAIEN,1,0)) Q

 S GMRCCIEN=0

 F  S GMRCCIEN=$O(^GMR(123,GMRCIEN,40,GMRCAIEN,1,GMRCCIEN)) Q:GMRCCIEN=""  D

 . S GMRCCOM=$G(^GMR(123,GMRCIEN,40,GMRCAIEN,1,GMRCCIEN,0))

 . I GMRCCOM="" S GMRCCOM="NO COMMENT AVAILABLE"

 . S ^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,GMRCCIEN)=GMRCCOM

GMRCP50   ;ISP/TDP - PRE INSTALL FOR GMRC*3*50 ; 11/29/2005

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

 +2        QUIT

EN        ;Entry point for manual start from programmer's prompt

 +1        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,NMFLG,X,Y

 +2        SET DIR(0)="Y"

 +3        SET DIR("A")="Print Full Patient Names on pre-install report"

 +4        SET DIR("B")="YES"

 +5        SET DIR("?")="Answer 'NO' to print patients' initials and last 6 of SSN."

 +6        SET DIR("?",1)="Answer 'YES' to print patients' full name and last 4 of SSN."

 +7        DO ^DIR

           IF (($GET(DIROUT))!($GET(DIRUT))!($GET(DUOUT))!($GET(DTOUT)))

               QUIT

 +8        SET NMFLG=Y

PRE       ;Start of Pre-init of patch GMRC*3*50

 +1        NEW GMRCTTL,GMRCITL

 +2        KILL ^TMP("GMRCP50",$JOB),^TMP("GMRCP50 IFC",$JOB)

 +3        IF '$DATA(NMFLG)

               NEW NMFLG

               Begin DoDot:1

 +4                SET NMFLG=$ORDER(XPDQUES(""))

 +5                SET NMFLG=$GET(XPDQUES(NMFLG))

               End DoDot:1

 +6        DO BMES^XPDUTL("Starting Pre-init...")

 +7        DO BMES^XPDUTL("   Searching for ampersand (""&"") in the SIGNIFICANT FINDINGS (#15) field")

 +8        DO MES^XPDUTL("   of the REQUEST/CONSULTATION (#123) file.")

 +9        DO MES^XPDUTL(" ")

 +10       DO SEARCH

 +11       IF GMRCTTL!(GMRCITL)

               DO MSG^GMRCP50A

 +12       DO BMES^XPDUTL("Pre-init complete.")

 +13       QUIT

SEARCH    ;Search SIGNIFICANT FINDINGS (#15) field of the REQUEST/CONSULTATION

 +1       ;(#123) file for ampersand ("&").

 +2        NEW GMRC0,GMRC40,GMRCACT,GMRCACDT,GMRCADT,GMRCAIEN,GMRCCIEN,GMRCCOM

 +3        NEW GMRCCPRS,GMRCDFN,GMRCDFN1,GMRCDONE,GMRCDT,GMRCIEN,GMRCIFC,GMRCSVC

 +4        NEW GMRCSSN,GMRCSSN1,GMRCWHO

 +5        SET (GMRCDT,GMRCITL,GMRCTTL)=0

 +6        FOR

               SET GMRCDT=$ORDER(^GMR(123,"B",GMRCDT))

               IF GMRCDT=""

                   QUIT

               Begin DoDot:1

 +7                SET GMRCIEN=""

 +8                FOR

                       SET GMRCIEN=$ORDER(^GMR(123,"B",GMRCDT,GMRCIEN))

                       IF GMRCIEN=""

                           QUIT

                       Begin DoDot:2

 +9                        SET GMRCDONE=0

 +10                       SET GMRC0=$GET(^GMR(123,GMRCIEN,0))

                           IF $PIECE(GMRC0,U,19)'="&"

                               QUIT

 +11                       SET GMRCIFC="GMRCP50"

 +12                       IF $PIECE($GET(^GMR(123,GMRCIEN,12)),U,5)="P"

                               SET GMRCIFC="GMRCP50 IFC"

 +13                       SET GMRCDFN=+$PIECE(GMRC0,U,2)

                           IF GMRCDFN

                               SET GMRCSSN=$PIECE($GET(^DPT(GMRCDFN,0)),U,9)

                               SET GMRCDFN=$PIECE($GET(^DPT(GMRCDFN,0)),U,1)

 +14                       SET GMRCSSN1="("_$EXTRACT(GMRCDFN,1)_$EXTRACT(GMRCSSN,6,9)_")"

 +15                       SET GMRCDFN1=GMRCDFN

 +16                       IF (GMRCDFN=0)!(GMRCDFN="")

                               SET GMRCDFN="PATIENT UNKNOWN"

 +17                       SET GMRCDFN=GMRCDFN_" "_GMRCSSN1

 +18                       SET GMRCSVC=+$PIECE(GMRC0,U,5)

                           IF GMRCSVC

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

 +19                       IF (GMRCSVC=0)!(GMRCSVC="")

                               SET GMRCSVC="SERVICE UNKNOWN"

 +20                       SET GMRCCPRS=+$PIECE(GMRC0,U,12)

                           IF GMRCCPRS

                               SET GMRCCPRS=$PIECE($GET(^ORD(100.01,GMRCCPRS,0)),U,1)

 +21                       IF (GMRCCPRS=0)!(GMRCCPRS="")

                               SET GMRCCPRS="STATUS UNKNOWN"

 +22                       DO ACTIVITY

 +23                       SET ^TMP(GMRCIFC,$JOB,GMRCDFN,GMRCDT,GMRCIEN,0)=GMRCIEN_U_GMRCSVC_U_GMRCCPRS_U_GMRCACT_U_GMRCACDT_U_GMRCWHO

 +24                       IF 'NMFLG

                               Begin DoDot:3

 +25                               SET ^TMP(GMRCIFC,$JOB,GMRCDFN,0)="("_$EXTRACT($PIECE(GMRCDFN1,",",2),1)_$EXTRACT($PIECE($PIECE(GMRCDFN1,",",2)," ",2),1)_$EXTRACT(GMRCDFN1,1)_$EXTRACT(GMRCSSN,4,9)_")"

                               End DoDot:3

 +26                       WRITE !,"   Consult entry "_GMRCIEN_" has an ampersand (""&"") as the Significant Finding."

 +27                       SET GMRCTTL=GMRCTTL+1

 +28                       IF GMRCIFC="GMRCP50 IFC"

                               SET GMRCITL=GMRCITL+1

                       End DoDot:2

               End DoDot:1

 +29       DO MES^XPDUTL(" ")

 +30       DO BMES^XPDUTL(GMRCTTL_" total consults contain an ampersand as the Significant Finding.")

 +31       QUIT

ACTIVITY  ;Search thru all Request Processing Activities and return any

 +1       ;Significant Findings or Administrative Completions.

 +2        NEW GMRCSIG,GMRCFLG

 +3        SET GMRCSIG=$ORDER(^GMR(123.1,"B","SIG FINDING UPDATE",""))

 +4        SET GMRCFLG=0

ACT1       SET (GMRCACDT,GMRCACT,GMRCADT,GMRCWHO)=""

 +1        FOR

               SET GMRCADT=$ORDER(^GMR(123,GMRCIEN,40,"B",GMRCADT),-1)

               IF GMRCADT=""

                   QUIT

               Begin DoDot:1

 +2                SET GMRCAIEN=""

 +3                FOR

                       SET GMRCAIEN=$ORDER(^GMR(123,GMRCIEN,40,"B",GMRCADT,GMRCAIEN))

                       IF GMRCAIEN=""

                           QUIT

                       Begin DoDot:2

 +4                        SET GMRC40=$GET(^GMR(123,GMRCIEN,40,GMRCAIEN,0))

                           IF $PIECE(GMRC40,U,2)'=GMRCSIG

                               QUIT

 +5                        SET GMRCACT=+$PIECE(GMRC40,U,2)

                           IF GMRCACT

                               SET GMRCACT=$PIECE($GET(^GMR(123.1,GMRCACT,0)),U,1)

 +6                        IF (GMRCACT=0)!(GMRCACT="")

                               SET GMRCACT="ACTIVITY UNKNOWN"

 +7                        SET GMRCACDT=+$PIECE(GMRC40,U,3)

 +8                        SET GMRCWHO=+$PIECE(GMRC40,U,4)

                           IF 'GMRCWHO

                               SET GMRCWHO=+$PIECE(GMRC40,U,5)

 +9                        IF 'GMRCWHO

                               SET GMRCWHO=$PIECE($GET(^GMR(123,GMRCIEN,40,GMRCAIEN,2)),U,2)

                               IF 'GMRCWHO

                                   SET GMRCWHO=$PIECE($GET(^GMR(123,GMRCIEN,40,GMRCAIEN,2)),U,1)

 +10                       IF +GMRCWHO

                               SET GMRCWHO=$PIECE($GET(^VA(200,GMRCWHO,0)),U,1)

 +11                       IF (GMRCWHO=0)!(GMRCWHO="")

                               SET GMRCWHO="RESP. PERSON UNKNOWN"

 +12                       DO COMMENT

 +13                       SET GMRCDONE=1

                       End DoDot:2

                       IF GMRCDONE

                           QUIT

               End DoDot:1

               IF GMRCDONE

                   QUIT

 +14       IF 'GMRCDONE

               IF 'GMRCFLG

                   SET GMRCSIG=$ORDER(^GMR(123.1,"B","COMPLETE/UPDATE",""))

                   SET GMRCFLG=1

                   DO ACT1

 +15       QUIT

COMMENT   ;Gather comment for Activity

 +1        IF '$DATA(^GMR(123,GMRCIEN,40,GMRCAIEN,1,0))

               QUIT

 +2        SET GMRCCIEN=0

 +3        FOR

               SET GMRCCIEN=$ORDER(^GMR(123,GMRCIEN,40,GMRCAIEN,1,GMRCCIEN))

               IF GMRCCIEN=""

                   QUIT

               Begin DoDot:1

 +4                SET GMRCCOM=$GET(^GMR(123,GMRCIEN,40,GMRCAIEN,1,GMRCCIEN,0))

 +5                IF GMRCCOM=""

                       SET GMRCCOM="NO COMMENT AVAILABLE"

 +6                SET ^TMP(GMRCIFC,$JOB,GMRCDFN,GMRCDT,GMRCIEN,GMRCCIEN)=GMRCCOM

               End DoDot:1

 +7        QUIT

GMRCP50.m