Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCYP68

GMRCYP68.m

Go to the documentation of this file.
  1. GMRCYP68 ;SLC/NG - POST INSTALL FOR GMRC*3*68 ;7/09/2010
  1. ;;3.0;CONSULT/REQUEST TRACKING;**68**;DEC 27, 1997;Build 21
  1. Q
  1. ;
  1. POST ; Start of Post-init for patch GMRC*3*68
  1. N GMRCTTL
  1. K ^TMP("GMRCYP68",$J)
  1. D BMES^XPDUTL("Starting Post-init...")
  1. D BMES^XPDUTL(" Searching for Consult Request which should be Inter-Facility")
  1. D MES^XPDUTL(" Consults, but are displaying as local Consults.")
  1. D MES^XPDUTL(" ")
  1. D SEARCH
  1. I GMRCTTL D MSG
  1. I 'GMRCTTL D BMES^XPDUTL(" No invalid entries found.")
  1. D BMES^XPDUTL("Post-init complete.")
  1. Q
  1. ;
  1. ;for invalid IFC services.
  1. N GMRCCPRS,GMRCSVC,GMRCSIEN,GMRCDT,X,GMRCSTS,GMRCDATE,GMRCINDT,GMRCPIFC
  1. N GMRCIFC1,GMRCIFC2,GMRCPRC,GMRCPRC1,GMRCPRC2,GMRCRFAC,GMRCSIEN0,I
  1. N GMRCIFC
  1. S (GMRCTTL,X)=0
  1. S (I,GMRCINDT,GMRCDATE,GMRCDT)=""
  1. S GMRCSTS=U
  1. F I="ACTIVE","PARTIAL RESULTS","PENDING","SCHEDULED" D
  1. . S GMRCSTS=GMRCSTS_$O(^ORD(100.01,"B",I,""))_U
  1. S X=$$INSTALDT^XPDUTL("GMRC*3.0*22",.GMRCINDT)
  1. I +X>0 F S GMRCDATE=$O(GMRCINDT(GMRCDATE)) Q:GMRCDATE="" D Q:GMRCDT'=""
  1. . I GMRCDATE<3020408 Q ;Don't set date if not greater than release date
  1. . S GMRCDT=GMRCDATE
  1. I 'GMRCDT S GMRCDT="3020407.9999999999" ;Set date to release date if no install date
  1. F S GMRCDT=$O(^GMR(123,"B",GMRCDT)) Q:GMRCDT="" D
  1. . S GMRCSIEN=0
  1. . F S GMRCSIEN=$O(^GMR(123,"B",GMRCDT,GMRCSIEN)) Q:GMRCSIEN="" D
  1. .. S (GMRCIFC,GMRCIFC1,GMRCIFC2,GMRCPIFC,GMRCPRC,GMRCPRC1,GMRCPRC2)=""
  1. .. S GMRCSIEN0=$G(^GMR(123,GMRCSIEN,0))
  1. .. S GMRCCPRS=$P($G(GMRCSIEN0),U,12)
  1. .. I GMRCSTS'[GMRCCPRS Q ;CPRS STATUS NOT ACTIVE, PENDING, SCHEDULED, OR PARTIAL RESULTS
  1. .. S GMRCCPRS=$P(^ORD(100.01,GMRCCPRS,0),U,1)
  1. .. S GMRCSVC=$P($G(GMRCSIEN0),U,5)
  1. .. S GMRCPRC=$P($G(GMRCSIEN0),U,8)
  1. .. I GMRCPRC'="" D
  1. ... S GMRCPRC1=$P($G(GMRCPRC),";",1),GMRCPRC2=$P($G(GMRCPRC),";",2)
  1. ... I $G(GMRCPRC2)="GMR(123.3,",+$G(GMRCPRC1)>0 D
  1. .... S GMRCPIFC=$G(^GMR(123.3,GMRCPRC1,"IFC"))
  1. .... S GMRCIFC1=+$P($G(GMRCPIFC),U,1),GMRCIFC2=$P($G(GMRCPIFC),U,2)
  1. .. I $G(GMRCIFC1)="",$G(GMRCIFC2)="",(($G(GMRCPRC)="")!($G(GMRCPRC2)'="GMR(123.3,")) D
  1. ... S GMRCIFC=$G(^GMR(123.5,+GMRCSVC,"IFC"))
  1. ... S GMRCIFC1=$P(GMRCIFC,U,1),GMRCIFC2=$P(GMRCIFC,U,2)
  1. .. I ('+GMRCIFC1)!(GMRCIFC2="") Q ;IFC ROUTING SITE^IFC REMOTE NAME (NOT AN IFC)
  1. .. S GMRCRFAC=$P($G(GMRCSIEN0),U,23)
  1. .. I +GMRCRFAC Q ;IF ROUTING FACILITY, NOT A PROBLEM ENTRY
  1. .. S GMRCSITE=$P($G(^DIC(4,GMRCIFC1,0)),U,1)
  1. .. S GMRCPIEN=$P($G(GMRCSIEN0),U,2)
  1. .. I +GMRCPIEN S GMRCNAME=$P($G(^DPT(GMRCPIEN,0)),U,1)_" ("_$E($P($G(^DPT(GMRCPIEN,0)),U,9),6,9)_")"
  1. .. E S GMRCPIEN=0,GMRCNAME="UNKNOWN"
  1. .. ;I $P(GMRCPRC,";",2)="GMR(123.3," S GMRCPRC=$P(^GMR(123.3,$P(GMRCPRC,";",1),0),U,1)
  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
  1. .. S GMRCTTL=GMRCTTL+1
  1. ;D MES^XPDUTL(" ")
  1. D BMES^XPDUTL(" "_GMRCTTL_" Total Invalid IFC Consult Request Records Found.")
  1. Q
  1. MSG ; Send Mailman message to installer
  1. N GMRCC,GMRCPARM,GMRCPRC,GMRCSVC,GMRCTXT,GMRCSIEN,GMRCNAME,GMRCSITE,GMRCIFC
  1. N GMRCPIEN,GMRCDT,GMRCDATE,GMRCSPS,GMRCIEN,GMRCMSG,GMRCSTS,GMRC0,GMRCCNT
  1. N XMDUZ,XMERR,XMSUB,XMTEXT,XMY,XMZ,Y
  1. I DUZ="" N DUZ S DUZ=.5 ; if user not defined set to postmaster
  1. S XMDUZ=DUZ,XMTEXT="GMRCTXT"
  1. S GMRCPARM("FROM")="PATCH GMRC*3.0*68 POST-INIT"
  1. S XMY(DUZ)="" ; send message to user
  1. S XMSUB="GMRC*3*68 - IFC CONSULTS NOT SENT"
  1. K GMRCTXT
  1. S GMRCC=0
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message has been sent by patch GMRC*3.0*68 at the completion of"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="the post-init routine."
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message was sent because Inter-Facility Consult records were found"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="which were not sent as Inter-Facility Consults and appear as local"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Consults. These IFC Consults are listed in this Mailman message so the"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="proper action may be taken to correct the erroneous IFC Consult Request"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Records. We have identified two different ways in which sites may correct"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="these incorrect IFC entries:"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" Option 1: After identifying and verifying the problem entry, forward the"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" problem entry to a different consult service/procedure and then"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" forward the entry back to the original service/procedure. This"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" action will correct the problem and allow the consult to transmit"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" properly to the consulting facility. If this option is used,"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" it is suggested the forwarding to service be made aware of"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" these pending actions and a standard message be devised to"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" be included as a comment for the effected consult entries."
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" Option 2: After identifying and verifying the problem entry, contact"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" the ordering provider to determine if the order is still"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" needed. Have the provider Discontinue the order. If the"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" order was no longer needed, then this is all that is needed."
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" If the order is needed, then the provider should re-order"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" it. Sites may want to create a standardized message for the"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" discontinued orders and new orders if appropriate."
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" Submit a Remedy ticket if you need additional instructions or help."
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="The following information is provided to assist you in your cleanup efforts."
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="PATIENT NAME (L4 SSN)"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" DATE IEN NUMBER STATUS"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" CONSULT REQUEST (SERVICE/PROCEDURE)"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" IFC ROUTING SITE"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" IFC REMOTE NAME"
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="=============================================================================="
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCCNT=0
  1. S GMRCSPS=" "
  1. S GMRCNAME=""
  1. F S GMRCNAME=$O(^TMP("GMRCYP68",$J,GMRCNAME)) Q:GMRCNAME="" D
  1. . S GMRCPIEN=""
  1. . F S GMRCPIEN=$O(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN)) Q:GMRCPIEN="" D
  1. .. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=GMRCNAME
  1. .. S GMRCDT=""
  1. .. F S GMRCDT=$O(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT)) Q:GMRCDT="" D
  1. ... S GMRCSIEN=""
  1. ... F S GMRCSIEN=$O(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN)) Q:GMRCSIEN="" D
  1. .... S GMRC0=$G(^TMP("GMRCYP68",$J,GMRCNAME,GMRCPIEN,GMRCDT,GMRCSIEN))
  1. .... S Y=GMRCDT D DD^%DT
  1. .... S GMRCDATE=$E(Y_" ",1,24)
  1. .... S GMRCSVC=$P(GMRC0,U,1)
  1. .... S GMRCSITE=$P(GMRC0,U,2)
  1. .... S GMRCIFC=$P(GMRC0,U,3)
  1. .... S GMRCIEN=$E(GMRCSIEN_" ",1,17)
  1. .... S GMRCSTS=$P(GMRC0,U,4)
  1. .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCDATE_GMRCIEN_GMRCSTS
  1. .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCSVC
  1. .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCSITE
  1. .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCIFC
  1. .... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. .... S GMRCCNT=GMRCCNT+1
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
  1. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total Invalid IFC Consult Request Records Found: "_GMRCCNT
  1. D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,.XMZ,"")
  1. I '$D(XMERR) D BMES^XPDUTL("Message #"_XMZ_" has been sent")
  1. I $D(XMERR) D
  1. . S GMRCMSG(1)=" "
  1. . S GMRCMSG(2)="******************************************************************************"
  1. . S GMRCMSG(3)="** Message containing IFC Consult records which were not **"
  1. . 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 **"))
  1. . I $D(XMERR) S GMRCMSG(5)="** Dumping message to screen. **"
  1. . I '$D(XMERR) S GMRCMSG(5)="** message to the appropriate staff, which includes the clinical **"
  1. . I '$D(XMERR) S GMRCMSG(6)="** coordinator, for further action. **"
  1. . S GMRCMSG($S($D(XMERR):6,1:7))="******************************************************************************"
  1. . D BMES^XPDUTL(GMRCMSG)
  1. I $D(XMERR) D BMES^XPDUTL(" "),BMES^XPDUTL(.GMRCTXT)
  1. K ^TMP("GMRCYP68",$J)
  1. Q