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

GMRCSTS1.m

Go to the documentation of this file. 
  1. GMRCSTS1 ;SLC/JFR,MA - GROUP UPDATE OF CONSULTS cont'd ;4/18/01  10:31
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**8,18,21,50**;DEC 27, 1997;Build 8
  1.  ; Patch 18 modified PRTTSK to stop for acknowledgement between
  1.  ; printing the report and continuing with the group update.
  1.  ; Patch 21 moved the ^%ZISC up a few lines to correct a problem
  1.  ; of menu going to the printer
  1.  ; This routine invokes IA #2638
  1. PROCESS(GMRCCVT,GMRCMT) ;Update consult status by service and date range
  1.  N GMRCO,GMRCSTS,GMRCTRLC,GMRCORNP,GMRCDEV,GMRCFF,GMRCAD,ORIFN
  1.  N GMRCOM1,ORIFN
  1.  Q:'GMRCCVT
  1.  I '$D(^TMP("GMRCLS",$J)) Q  ;no entries to update
  1.  S GMRCIEN=0 F  S GMRCIEN=$O(^TMP("GMRCLS",$J,GMRCIEN)) Q:'GMRCIEN  D
  1.  . Q:'$L($G(^GMR(123,GMRCIEN,0)))
  1.  . D AUDIT(GMRCIEN,+GMRCCVT,.GMRCMT)
  1.  . D STSUPD(GMRCIEN,+GMRCCVT)
  1.  . D CPRSUPDT(GMRCIEN,+GMRCCVT)
  1.  Q
  1. PRINT(GMRCM,GMRCCVT,GMRCSVC,GMRCMT,GMRCSTRT,GMRCSTOP,GMRCDO) ;untasked print of records to update
  1. PRTTSK ; print the report then start the processing
  1.  ; GMRCM= status of records to find A:active, P:pending, B:Both
  1.  ; GMRCCVT= status to update records with  1:dc,  2:complete
  1.  ; GMRCSVC= IEN from file 123.5
  1.  ; GMRCMT= array (passed by reference) of comment to stuff in records
  1.  ; GMRCSTRT= first entry date to find/update
  1.  ; GMRCSTOP= last entry date to find/update
  1.  ; GMRCDO= 1:print only, 2:print and update records
  1.  ; GMRCSTAT= Status of consult for the report (P,A,S)
  1.  N GMRCIEN,GMRCDFN,GMRCPG,GMRCEND,GMRCSTAT
  1.  S GMRCIEN=0
  1.  U IO
  1.  D HDR(1) S GMRCPG=2
  1.  I '$D(^TMP("GMRCLS",$J)) D  D END
  1.  . W !,"No records found meeting search criteria"
  1.  F  S GMRCIEN=$O(^TMP("GMRCLS",$J,GMRCIEN)) Q:'GMRCIEN!($G(GMRCEND))  D
  1.  . I $Y>(IOSL-5) D HDR(GMRCPG) Q:$G(GMRCEND)  S GMRCPG=GMRCPG+1
  1.  . Q:'$G(^GMR(123,GMRCIEN,0))
  1.  . I $P(^GMR(123,GMRCIEN,0),U,12)=1!($P(^(0),U,12)=2) Q
  1.  . W !,GMRCIEN,?8,$$FMTE^XLFDT(+^GMR(123,GMRCIEN,0))
  1.  . W ?29,$E($$GET1^DIQ(2,$P(^GMR(123,GMRCIEN,0),U,2),.01),1,26)
  1.  . W ?56,$$GET1^DIQ(2,$P(^GMR(123,GMRCIEN,0),U,2),.09)
  1.  . S GMRCSTAT=+^TMP("GMRCLS",$J,GMRCIEN)
  1.  . W ?70,$S(GMRCSTAT=5:"p",GMRCSTAT=6:"a",GMRCSTAT=8:"s",1:"?")
  1.  . W " to ",$S(+GMRCCVT=1:"dc",1:"c")
  1.  D ^%ZISC
  1.  I GMRCDO=2,'$D(ZTQUEUED) D  ; Not task
  1.  . S DIR(0)="S^Y:To Update;N:To Quit without Updating"
  1.  . S DIR("A")="Enter update status "
  1.  . I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) Q
  1.  . D ^DIR
  1.  . I Y="Y" D PROCESS(+GMRCCVT,.GMRCMT)
  1.  I GMRCDO=2,$D(ZTQUEUED) D PROCESS(+GMRCCVT,.GMRCMT) ; Tasked
  1. END K ^TMP("GMRCLS",$J)
  1.  Q
  1.  ;
  1. HDR(PAGE) ; print the header for the report
  1.  I PAGE'=1,$E(IOST,1,2)["C-" N Y D  I '+Y S GMRCEND=1 Q
  1.  . N DIR S DIR(0)="E" D ^DIR
  1.  W @IOF
  1.  W !,"Group status update of consults in file 123",?70,"Page: ",PAGE W:PAGE'=1 !
  1.  I PAGE=1 W !,?49,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT)
  1.  I PAGE=1 D UPDCRIT(GMRCCVT,GMRCM,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP)
  1.  W !,"Consult",?70,"Status"
  1.  W !,"Number    Requested          Patient                    SSN           Change"
  1.  W !,$$REPEAT^XLFSTR("-",79)
  1.  Q
  1. GETENTS(SERV,STRDT,STPDT,SRCH)  ;loop "AE" x-ref and dump into ^TMP
  1.  N IDT,IEN,STOPI,STRTI,STS,INDEX
  1.  W !!,"Searching database for entries matching search criteria",!
  1.  S STOPI=(9999999-STPDT)-1,STRTI=(9999999-STRDT)
  1.  F INDEX=1:1  Q:$P(SRCH,",",INDEX)=""  D
  1.  . I $P(SRCH,",",INDEX)=+4 S SRCH="1,2,3,"
  1.  ; Convert SRCH from 1,2,3 to 5,6,8 (pending,active,scheduled)
  1.  F INDEX=1:1  Q:$P(SRCH,",",INDEX)=""  D
  1.  . I $P(SRCH,",",INDEX)=+1 S STS=+5 D GETDATA
  1.  . I $P(SRCH,",",INDEX)=+2 S STS=+6 D GETDATA
  1.  . I $P(SRCH,",",INDEX)=+3 S STS=+8 D GETDATA
  1. GETDATA ; Write ^GMR(123,IEN,0) to TMP
  1.  S IDT=STOPI
  1.  F  S IDT=$O(^GMR(123,"AE",SERV,+STS,IDT)) Q:'IDT!(IDT>STRTI)  D
  1.  . S IEN=0 F  S IEN=$O(^GMR(123,"AE",SERV,+STS,IDT,IEN)) Q:'IEN  D
  1.  .. S ^TMP("GMRCLS",$J,IEN)=+STS_U_+^GMR(123,IEN,0)
  1.  .. W "."
  1.  Q
  1. AUDIT(GMRCO,UPDSTS,GMRCOM) ;Update the processing activity of the consult
  1.  ;GMRCO= IEN from file 123
  1.  ;UPDSTS= 1 for DC ;  2 for COMPLETE
  1.  N DA,DIE,GMRCA,GMRCDT,GMRCSTS
  1.  S GMRCDT=$$NOW^XLFDT,GMRCA=$S(UPDSTS=1:6,1:10)
  1.  S GMRCSTS=$P(^GMR(123,GMRCO,0),U,12)
  1.  S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^"
  1.  S DA=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1),$P(^GMR(123,GMRCO,40,0),"^",3,4)=DA_"^"_DA
  1.  S DIE="^GMR(123,"_+GMRCO_",40,",DA(1)=+GMRCO
  1.  S DR=".01////^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCDT;3////^S X=DUZ;4////^S X=DUZ"
  1.  D ^DIE
  1.  S ^GMR(123,+GMRCO,40,DA,1,0)="^^1^1^"_GMRCDT_"^"
  1.  I $D(GMRCOM) D
  1.  . M ^GMR(123,+GMRCO,40,DA,1)=GMRCOM
  1.  I '$D(GMRCOM) D
  1.  . N COMMENT
  1.  . S COMMENT="Status updated from "
  1.  . S COMMENT=COMMENT_$P(^ORD(100.01,+GMRCSTS,0),"^",1)
  1.  . S COMMENT=COMMENT_" to "_$S(+UPDSTS=2:"COMPLETE",1:"DISCONTINUED")
  1.  . S COMMENT=COMMENT_" during group status update process."
  1.  . S ^GMR(123,+GMRCO,40,DA,1,1,0)=COMMENT
  1.  ;Check for IFC and update accordingly
  1.  I $D(^GMR(123,+GMRCO,12)),$D(^(40,DA)) D TRIGR^GMRCIEVT(GMRCO,DA)
  1.  K DIE,GMRCA,GMRCDT
  1.  Q
  1. STSUPD(GMRCO,UPDSTS) ;change status of consult to COMPLETE or DC
  1.  ;GMRCO= IEN from file 123
  1.  ;UPDSTS= 1 for DC ;  2 for COMPLETE
  1.  N DIE,DA,DR,GMRCLST,X
  1.  S GMRCLST=$S(UPDSTS=1:$O(^GMR(123.1,"B","DISCONTINUED",0)),UPDSTS=2:$O(^GMR(123.1,"B","COMPLETE/UPDATE",0)),1:99)
  1.  S DIE="^GMR(123,",DA=GMRCO
  1.  S DR="8////^S X=+UPDSTS;9////"_GMRCLST
  1.  D ^DIE
  1.  Q
  1. CPRSUPDT(GMRCO,UPDSTS) ;Update CPRS order with new status
  1.  ;GMRCO= IEN from file 123
  1.  ;UPDSTS= status to update CPRS with
  1.  N GMRCDFN,CTRLCODE
  1.  S GMRCDFN=$P(^GMR(123,GMRCO,0),"^",2)
  1.  S CTRLCODE=$S(UPDSTS=1:"OD",1:"RE")
  1.  ; send HL7 message to CPRS to update order status
  1.  D EN^GMRCHL7(GMRCDFN,+GMRCO,"","",CTRLCODE,DUZ,"","",1)
  1.  Q
  1. UPDCRIT(UPD,STS,SVC,CMT,START,STOP) ;print update criteria on page 1
  1.  N INDEX,GMRCSTS
  1.  F INDEX=1:1  Q:$P(STS,",",INDEX)=""  D
  1.  . I STS[+4 S GMRCSTS="Active, Pending, and Scheduled" Q
  1.  . I $P(STS,",",INDEX)=+1 S $P(GMRCSTS,",",INDEX)="Pending"
  1.  . I $P(STS,",",INDEX)=+2 S $P(GMRCSTS,",",INDEX)="Active"
  1.  . I $P(STS,",",INDEX)=+3 S $P(GMRCSTS,",",INDEX)="Scheduled"
  1.  W !,"Records will be updated for:"
  1.  W !,$$REPEAT^XLFSTR("-",78)
  1.  W !,"          Service: "_$$GET1^DIQ(123.5,SVC,.01)
  1.  W !,"        Beginning: "_$$FMTE^XLFDT(START)
  1.  W !,"           Ending: "_$$FMTE^XLFDT(STOP)
  1.  W !,"           Update: "_GMRCSTS_" "_" Consults"
  1.  W !,"               To: "_$S(+UPD=2:"COMPLETE",1:"DISCONTINUED")
  1.  I $D(CMT) W !,"   Update Comment:" D
  1.  . N I S I=0 F  S I=$O(CMT(I)) Q:'I  D
  1.  .. W !,CMT(I,0)
  1.  W !,$$REPEAT^XLFSTR("-",78),!
  1.  Q