GMRCP50 ;ISP/TDP - PRE INSTALL FOR GMRC*3*50 ; 11/29/2005
;;3.0;CONSULT/REQUEST TRACKING;**50**;DEC 27, 1997;Build 8
Q
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.")
Q
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.")
Q
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
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP50 4317 printed Apr 09, 2024@20:50:47 Page 2
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
+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
