- GMRCYP68 ;SLC/NG - POST INSTALL FOR GMRC*3*68 ;7/09/2010
- ;;3.0;CONSULT/REQUEST TRACKING;**68**;DEC 27, 1997;Build 21
- Q
- ;
- POST ; Start of Post-init for patch GMRC*3*68
- N GMRCTTL
- K ^TMP("GMRCYP68",$J)
- D BMES^XPDUTL("Starting Post-init...")
- D BMES^XPDUTL(" Searching for Consult Request which should be Inter-Facility")
- D MES^XPDUTL(" Consults, but are displaying as local Consults.")
- D MES^XPDUTL(" ")
- D SEARCH
- I GMRCTTL D MSG
- I 'GMRCTTL D BMES^XPDUTL(" No invalid entries found.")
- D BMES^XPDUTL("Post-init complete.")
- Q
- ;
- SEARCH ; Search RELATED SERVICES (#2) field of the GMRC PROCEDURE (#123) file
- ;for invalid IFC services.
- N GMRCCPRS,GMRCSVC,GMRCSIEN,GMRCDT,X,GMRCSTS,GMRCDATE,GMRCINDT,GMRCPIFC
- N GMRCIFC1,GMRCIFC2,GMRCPRC,GMRCPRC1,GMRCPRC2,GMRCRFAC,GMRCSIEN0,I
- N GMRCIFC
- S (GMRCTTL,X)=0
- S (I,GMRCINDT,GMRCDATE,GMRCDT)=""
- S GMRCSTS=U
- F I="ACTIVE","PARTIAL RESULTS","PENDING","SCHEDULED" D
- . S GMRCSTS=GMRCSTS_$O(^ORD(100.01,"B",I,""))_U
- S X=$$INSTALDT^XPDUTL("GMRC*3.0*22",.GMRCINDT)
- I +X>0 F S GMRCDATE=$O(GMRCINDT(GMRCDATE)) Q:GMRCDATE="" D Q:GMRCDT'=""
- . I GMRCDATE<3020408 Q ;Don't set date if not greater than release date
- . S GMRCDT=GMRCDATE
- I 'GMRCDT S GMRCDT="3020407.9999999999" ;Set date to release date if no install date
- F S GMRCDT=$O(^GMR(123,"B",GMRCDT)) Q:GMRCDT="" D
- . S GMRCSIEN=0
- . F S GMRCSIEN=$O(^GMR(123,"B",GMRCDT,GMRCSIEN)) Q:GMRCSIEN="" D
- .. S (GMRCIFC,GMRCIFC1,GMRCIFC2,GMRCPIFC,GMRCPRC,GMRCPRC1,GMRCPRC2)=""
- .. S GMRCSIEN0=$G(^GMR(123,GMRCSIEN,0))
- .. S GMRCCPRS=$P($G(GMRCSIEN0),U,12)
- .. I GMRCSTS'[GMRCCPRS Q ;CPRS STATUS NOT ACTIVE, PENDING, SCHEDULED, OR PARTIAL RESULTS
- .. S GMRCCPRS=$P(^ORD(100.01,GMRCCPRS,0),U,1)
- .. S GMRCSVC=$P($G(GMRCSIEN0),U,5)
- .. S GMRCPRC=$P($G(GMRCSIEN0),U,8)
- .. I GMRCPRC'="" D
- ... S GMRCPRC1=$P($G(GMRCPRC),";",1),GMRCPRC2=$P($G(GMRCPRC),";",2)
- ... I $G(GMRCPRC2)="GMR(123.3,",+$G(GMRCPRC1)>0 D
- .... S GMRCPIFC=$G(^GMR(123.3,GMRCPRC1,"IFC"))
- .... S GMRCIFC1=+$P($G(GMRCPIFC),U,1),GMRCIFC2=$P($G(GMRCPIFC),U,2)
- .. I $G(GMRCIFC1)="",$G(GMRCIFC2)="",(($G(GMRCPRC)="")!($G(GMRCPRC2)'="GMR(123.3,")) D
- ... S GMRCIFC=$G(^GMR(123.5,+GMRCSVC,"IFC"))
- ... S GMRCIFC1=$P(GMRCIFC,U,1),GMRCIFC2=$P(GMRCIFC,U,2)
- .. I ('+GMRCIFC1)!(GMRCIFC2="") Q ;IFC ROUTING SITE^IFC REMOTE NAME (NOT AN IFC)
- .. S GMRCRFAC=$P($G(GMRCSIEN0),U,23)
- .. I +GMRCRFAC Q ;IF ROUTING FACILITY, NOT A PROBLEM ENTRY
- .. S GMRCSITE=$P($G(^DIC(4,GMRCIFC1,0)),U,1)
- .. S GMRCPIEN=$P($G(GMRCSIEN0),U,2)
- .. I +GMRCPIEN S GMRCNAME=$P($G(^DPT(GMRCPIEN,0)),U,1)_" ("_$E($P($G(^DPT(GMRCPIEN,0)),U,9),6,9)_")"
- .. E S GMRCPIEN=0,GMRCNAME="UNKNOWN"
- .. ;I $P(GMRCPRC,";",2)="GMR(123.3," S GMRCPRC=$P(^GMR(123.3,$P(GMRCPRC,";",1),0),U,1)
- .. S ^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN)=$S((($G(GMRCPRC2)="GMR(123.3,")&(+$G(GMRCPRC1)>0)):$P($G(^GMR(123.3,+GMRCPRC1,0)),U,1)_" (PROCEDURE)",1:$P($G(^GMR(123.5,+GMRCSVC,0)),U,1)_" (SERVICE)")_U_GMRCSITE_U_GMRCIFC2_U_GMRCCPRS
- .. S GMRCTTL=GMRCTTL+1
- ;D MES^XPDUTL(" ")
- D BMES^XPDUTL(" "_GMRCTTL_" Total Invalid IFC Consult Request Records Found.")
- Q
- MSG ; Send Mailman message to installer
- N GMRCC,GMRCPARM,GMRCPRC,GMRCSVC,GMRCTXT,GMRCSIEN,GMRCNAME,GMRCSITE,GMRCIFC
- N GMRCPIEN,GMRCDT,GMRCDATE,GMRCSPS,GMRCIEN,GMRCMSG,GMRCSTS,GMRC0,GMRCCNT
- N XMDUZ,XMERR,XMSUB,XMTEXT,XMY,XMZ,Y
- 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*68 POST-INIT"
- S XMY(DUZ)="" ; send message to user
- S XMSUB="GMRC*3*68 - IFC CONSULTS NOT SENT"
- K GMRCTXT
- S GMRCC=0
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message has been sent by patch GMRC*3.0*68 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 Inter-Facility Consult records were found"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="which were not sent as Inter-Facility Consults and appear as local"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Consults. These IFC Consults are listed in this Mailman message so the"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="proper action may be taken to correct the erroneous IFC Consult Request"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Records. We have identified two different ways in which sites may correct"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="these incorrect IFC entries:"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" Option 1: After identifying and verifying the problem entry, forward the"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" problem entry to a different consult service/procedure and then"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" forward the entry back to the original service/procedure. This"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" action will correct the problem and allow the consult to transmit"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" properly to the consulting facility. If this option is used,"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" it is suggested the forwarding to service be made aware of"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" these pending actions and a standard message be devised to"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" be included as a comment for the effected consult entries."
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" Option 2: After identifying and verifying the problem entry, contact"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" the ordering provider to determine if the order is still"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" needed. Have the provider Discontinue the order. If the"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" order was no longer needed, then this is all that is needed."
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" If the order is needed, then the provider should re-order"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" it. Sites may want to create a standardized message for the"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" discontinued orders and new orders if appropriate."
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" Submit a Remedy ticket if you need additional instructions or help."
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="The following information is provided to assist you in your cleanup efforts."
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="PATIENT NAME (L4 SSN)"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" DATE IEN NUMBER STATUS"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" CONSULT REQUEST (SERVICE/PROCEDURE)"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" IFC ROUTING SITE"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" IFC REMOTE NAME"
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="=============================================================================="
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCCNT=0
- S GMRCSPS=" "
- S GMRCNAME=""
- F S GMRCNAME=$O(^TMP("GMRCYP68",$J,GMRCNAME)) Q:GMRCNAME="" D
- . S GMRCPIEN=""
- . F S GMRCPIEN=$O(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN)) Q:GMRCPIEN="" D
- .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=GMRCNAME
- .. S GMRCDT=""
- .. F S GMRCDT=$O(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT)) Q:GMRCDT="" D
- ... S GMRCSIEN=""
- ... F S GMRCSIEN=$O(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN)) Q:GMRCSIEN="" D
- .... S GMRC0=$G(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN))
- .... S Y=GMRCDT D DD^%DT
- .... S GMRCDATE=$E(Y_" ",1,24)
- .... S GMRCSVC=$P(GMRC0,U,1)
- .... S GMRCSITE=$P(GMRC0,U,2)
- .... S GMRCIFC=$P(GMRC0,U,3)
- .... S GMRCIEN=$E(GMRCSIEN_" ",1,17)
- .... S GMRCSTS=$P(GMRC0,U,4)
- .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCDATE_GMRCIEN_GMRCSTS
- .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCSVC
- .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCSITE
- .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCIFC
- .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- .... S GMRCCNT=GMRCCNT+1
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
- S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total Invalid IFC Consult Request Records Found: "_GMRCCNT
- D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,.XMZ,"")
- I '$D(XMERR) D BMES^XPDUTL("Message #"_XMZ_" has been sent")
- I $D(XMERR) D
- . S GMRCMSG(1)=" "
- . S GMRCMSG(2)="******************************************************************************"
- . S GMRCMSG(3)="** Message containing IFC Consult records which were not **"
- . S GMRCMSG(4)="** sent due "_$S($D(XMERR):"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("GMRCYP68",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP68 9149 printed Jan 18, 2025@02:49:13 Page 2
- GMRCYP68 ;SLC/NG - POST INSTALL FOR GMRC*3*68 ;7/09/2010
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**68**;DEC 27, 1997;Build 21
- +2 QUIT
- +3 ;
- POST ; Start of Post-init for patch GMRC*3*68
- +1 NEW GMRCTTL
- +2 KILL ^TMP("GMRCYP68",$JOB)
- +3 DO BMES^XPDUTL("Starting Post-init...")
- +4 DO BMES^XPDUTL(" Searching for Consult Request which should be Inter-Facility")
- +5 DO MES^XPDUTL(" Consults, but are displaying as local Consults.")
- +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) file
- +1 ;for invalid IFC services.
- +2 NEW GMRCCPRS,GMRCSVC,GMRCSIEN,GMRCDT,X,GMRCSTS,GMRCDATE,GMRCINDT,GMRCPIFC
- +3 NEW GMRCIFC1,GMRCIFC2,GMRCPRC,GMRCPRC1,GMRCPRC2,GMRCRFAC,GMRCSIEN0,I
- +4 NEW GMRCIFC
- +5 SET (GMRCTTL,X)=0
- +6 SET (I,GMRCINDT,GMRCDATE,GMRCDT)=""
- +7 SET GMRCSTS=U
- +8 FOR I="ACTIVE","PARTIAL RESULTS","PENDING","SCHEDULED"
- Begin DoDot:1
- +9 SET GMRCSTS=GMRCSTS_$ORDER(^ORD(100.01,"B",I,""))_U
- End DoDot:1
- +10 SET X=$$INSTALDT^XPDUTL("GMRC*3.0*22",.GMRCINDT)
- +11 IF +X>0
- FOR
- SET GMRCDATE=$ORDER(GMRCINDT(GMRCDATE))
- if GMRCDATE=""
- QUIT
- Begin DoDot:1
- +12 ;Don't set date if not greater than release date
- IF GMRCDATE<3020408
- QUIT
- +13 SET GMRCDT=GMRCDATE
- End DoDot:1
- if GMRCDT'=""
- QUIT
- +14 ;Set date to release date if no install date
- IF 'GMRCDT
- SET GMRCDT="3020407.9999999999"
- +15 FOR
- SET GMRCDT=$ORDER(^GMR(123,"B",GMRCDT))
- if GMRCDT=""
- QUIT
- Begin DoDot:1
- +16 SET GMRCSIEN=0
- +17 FOR
- SET GMRCSIEN=$ORDER(^GMR(123,"B",GMRCDT,GMRCSIEN))
- if GMRCSIEN=""
- QUIT
- Begin DoDot:2
- +18 SET (GMRCIFC,GMRCIFC1,GMRCIFC2,GMRCPIFC,GMRCPRC,GMRCPRC1,GMRCPRC2)=""
- +19 SET GMRCSIEN0=$GET(^GMR(123,GMRCSIEN,0))
- +20 SET GMRCCPRS=$PIECE($GET(GMRCSIEN0),U,12)
- +21 ;CPRS STATUS NOT ACTIVE, PENDING, SCHEDULED, OR PARTIAL RESULTS
- IF GMRCSTS'[GMRCCPRS
- QUIT
- +22 SET GMRCCPRS=$PIECE(^ORD(100.01,GMRCCPRS,0),U,1)
- +23 SET GMRCSVC=$PIECE($GET(GMRCSIEN0),U,5)
- +24 SET GMRCPRC=$PIECE($GET(GMRCSIEN0),U,8)
- +25 IF GMRCPRC'=""
- Begin DoDot:3
- +26 SET GMRCPRC1=$PIECE($GET(GMRCPRC),";",1)
- SET GMRCPRC2=$PIECE($GET(GMRCPRC),";",2)
- +27 IF $GET(GMRCPRC2)="GMR(123.3,"
- IF +$GET(GMRCPRC1)>0
- Begin DoDot:4
- +28 SET GMRCPIFC=$GET(^GMR(123.3,GMRCPRC1,"IFC"))
- +29 SET GMRCIFC1=+$PIECE($GET(GMRCPIFC),U,1)
- SET GMRCIFC2=$PIECE($GET(GMRCPIFC),U,2)
- End DoDot:4
- End DoDot:3
- +30 IF $GET(GMRCIFC1)=""
- IF $GET(GMRCIFC2)=""
- IF (($GET(GMRCPRC)="")!($GET(GMRCPRC2)'="GMR(123.3,"))
- Begin DoDot:3
- +31 SET GMRCIFC=$GET(^GMR(123.5,+GMRCSVC,"IFC"))
- +32 SET GMRCIFC1=$PIECE(GMRCIFC,U,1)
- SET GMRCIFC2=$PIECE(GMRCIFC,U,2)
- End DoDot:3
- +33 ;IFC ROUTING SITE^IFC REMOTE NAME (NOT AN IFC)
- IF ('+GMRCIFC1)!(GMRCIFC2="")
- QUIT
- +34 SET GMRCRFAC=$PIECE($GET(GMRCSIEN0),U,23)
- +35 ;IF ROUTING FACILITY, NOT A PROBLEM ENTRY
- IF +GMRCRFAC
- QUIT
- +36 SET GMRCSITE=$PIECE($GET(^DIC(4,GMRCIFC1,0)),U,1)
- +37 SET GMRCPIEN=$PIECE($GET(GMRCSIEN0),U,2)
- +38 IF +GMRCPIEN
- SET GMRCNAME=$PIECE($GET(^DPT(GMRCPIEN,0)),U,1)_" ("_$EXTRACT($PIECE($GET(^DPT(GMRCPIEN,0)),U,9),6,9)_")"
- +39 IF '$TEST
- SET GMRCPIEN=0
- SET GMRCNAME="UNKNOWN"
- +40 ;I $P(GMRCPRC,";",2)="GMR(123.3," S GMRCPRC=$P(^GMR(123.3,$P(GMRCPRC,";",1),0),U,1)
- +41 SET ^TMP("GMRCYP68",$JOB,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN)=$SELECT(((...
- ... $GET(GMRCPRC2)="GMR(123.3,")&(+$GET(GMRCPRC1)>0)):$PIECE($GET(^GMR(123.3,+GMRCPRC1,0)),U,1)_" (PROCEDURE)",1:$PIECE($GET(^GMR(123.5,+GMRCSVC,0)),U,1)_" (SERVICE)")_U_GMRCSITE_U_GMRCIFC2_U_GMRCCPRS
- +42 SET GMRCTTL=GMRCTTL+1
- End DoDot:2
- End DoDot:1
- +43 ;D MES^XPDUTL(" ")
- +44 DO BMES^XPDUTL(" "_GMRCTTL_" Total Invalid IFC Consult Request Records Found.")
- +45 QUIT
- MSG ; Send Mailman message to installer
- +1 NEW GMRCC,GMRCPARM,GMRCPRC,GMRCSVC,GMRCTXT,GMRCSIEN,GMRCNAME,GMRCSITE,GMRCIFC
- +2 NEW GMRCPIEN,GMRCDT,GMRCDATE,GMRCSPS,GMRCIEN,GMRCMSG,GMRCSTS,GMRC0,GMRCCNT
- +3 NEW XMDUZ,XMERR,XMSUB,XMTEXT,XMY,XMZ,Y
- +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*68 POST-INIT"
- +7 ; send message to user
- SET XMY(DUZ)=""
- +8 SET XMSUB="GMRC*3*68 - IFC CONSULTS NOT SENT"
- +9 KILL GMRCTXT
- +10 SET GMRCC=0
- +11 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="This message has been sent by patch GMRC*3.0*68 at the completion of"
- +12 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="the post-init routine."
- +13 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +14 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="This message was sent because Inter-Facility Consult records were found"
- +15 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="which were not sent as Inter-Facility Consults and appear as local"
- +16 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="Consults. These IFC Consults are listed in this Mailman message so the"
- +17 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="proper action may be taken to correct the erroneous IFC Consult Request"
- +18 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="Records. We have identified two different ways in which sites may correct"
- +19 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="these incorrect IFC entries:"
- +20 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +21 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" Option 1: After identifying and verifying the problem entry, forward the"
- +22 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" problem entry to a different consult service/procedure and then"
- +23 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" forward the entry back to the original service/procedure. This"
- +24 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" action will correct the problem and allow the consult to transmit"
- +25 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" properly to the consulting facility. If this option is used,"
- +26 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" it is suggested the forwarding to service be made aware of"
- +27 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" these pending actions and a standard message be devised to"
- +28 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" be included as a comment for the effected consult entries."
- +29 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +30 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" Option 2: After identifying and verifying the problem entry, contact"
- +31 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" the ordering provider to determine if the order is still"
- +32 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" needed. Have the provider Discontinue the order. If the"
- +33 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" order was no longer needed, then this is all that is needed."
- +34 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" If the order is needed, then the provider should re-order"
- +35 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" it. Sites may want to create a standardized message for the"
- +36 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" discontinued orders and new orders if appropriate."
- +37 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +38 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" Submit a Remedy ticket if you need additional instructions or help."
- +39 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +40 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="The following information is provided to assist you in your cleanup efforts."
- +41 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +42 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="PATIENT NAME (L4 SSN)"
- +43 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" DATE IEN NUMBER STATUS"
- +44 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" CONSULT REQUEST (SERVICE/PROCEDURE)"
- +45 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" IFC ROUTING SITE"
- +46 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" IFC REMOTE NAME"
- +47 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="=============================================================================="
- +48 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +49 SET GMRCCNT=0
- +50 SET GMRCSPS=" "
- +51 SET GMRCNAME=""
- +52 FOR
- SET GMRCNAME=$ORDER(^TMP("GMRCYP68",$JOB,GMRCNAME))
- if GMRCNAME=""
- QUIT
- Begin DoDot:1
- +53 SET GMRCPIEN=""
- +54 FOR
- SET GMRCPIEN=$ORDER(^TMP("GMRCYP68",$JOB,GMRCNAME,GMRCPIEN))
- if GMRCPIEN=""
- QUIT
- Begin DoDot:2
- +55 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=GMRCNAME
- +56 SET GMRCDT=""
- +57 FOR
- SET GMRCDT=$ORDER(^TMP("GMRCYP68",$JOB,GMRCNAME,GMRCPIEN,GMRCDT))
- if GMRCDT=""
- QUIT
- Begin DoDot:3
- +58 SET GMRCSIEN=""
- +59 FOR
- SET GMRCSIEN=$ORDER(^TMP("GMRCYP68",$JOB,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN))
- if GMRCSIEN=""
- QUIT
- Begin DoDot:4
- +60 SET GMRC0=$GET(^TMP("GMRCYP68",$JOB,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN))
- +61 SET Y=GMRCDT
- DO DD^%DT
- +62 SET GMRCDATE=$EXTRACT(Y_" ",1,24)
- +63 SET GMRCSVC=$PIECE(GMRC0,U,1)
- +64 SET GMRCSITE=$PIECE(GMRC0,U,2)
- +65 SET GMRCIFC=$PIECE(GMRC0,U,3)
- +66 SET GMRCIEN=$EXTRACT(GMRCSIEN_" ",1,17)
- +67 SET GMRCSTS=$PIECE(GMRC0,U,4)
- +68 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "_GMRCDATE_GMRCIEN_GMRCSTS
- +69 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "_GMRCSVC
- +70 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "_GMRCSITE
- +71 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "_GMRCIFC
- +72 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +73 SET GMRCCNT=GMRCCNT+1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +74 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)=" "
- +75 SET GMRCC=GMRCC+1
- SET GMRCTXT(GMRCC)="Total Invalid IFC Consult Request Records Found: "_GMRCCNT
- +76 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,.XMZ,"")
- +77 IF '$DATA(XMERR)
- DO BMES^XPDUTL("Message #"_XMZ_" has been sent")
- +78 IF $DATA(XMERR)
- Begin DoDot:1
- +79 SET GMRCMSG(1)=" "
- +80 SET GMRCMSG(2)="******************************************************************************"
- +81 SET GMRCMSG(3)="** Message containing IFC Consult records which were not **"
- +82 SET GMRCMSG(4)="** sent due "_$SELECT($DATA(XMERR):"to an error in the message set up. **",1:"sent to the "_$SELECT(DUZ=.5:"postmaster. Please forward this **",1:"user. Please forward this **"))
- +83 IF $DATA(XMERR)
- SET GMRCMSG(5)="** Dumping message to screen. **"
- +84 IF '$DATA(XMERR)
- SET GMRCMSG(5)="** message to the appropriate staff, which includes the clinical **"
- +85 IF '$DATA(XMERR)
- SET GMRCMSG(6)="** coordinator, for further action. **"
- +86 SET GMRCMSG($SELECT($DATA(XMERR):6,1:7))="******************************************************************************"
- +87 DO BMES^XPDUTL(GMRCMSG)
- End DoDot:1
- +88 IF $DATA(XMERR)
- DO BMES^XPDUTL(" ")
- DO BMES^XPDUTL(.GMRCTXT)
- +89 KILL ^TMP("GMRCYP68",$JOB)
- +90 QUIT