GMRCSTS ;SLC/DLT,JFR,MA - Group update status of consult and order; 11/25/2000
;;3.0;CONSULT/REQUEST TRACKING;**8,18,21,76**;DEC 27, 1997;Build 7
; Patch 18 - Change UPDCMT to use Editor to add comment and
; Added Scheduled consults to selection list.
; Patch 21 - Added warning message in line tag WARNING().
; This routine invokes IA #2876,3121
N GMRCTO,GMRCDG,GMRCSVC,GMRCSVCN,GMRCEND,GMRCSTRT,GMRCSTOP,GMRCGRP
N GMRCCVT,GMRCM,GMRCMT,GMRCDO,DIR,DIROUT,DIRUT,DTOUT,DUOUT
D GETSRV I 'GMRCDG D END Q
D GETDTR I GMRCEND D END Q
S GMRCM=$$METHOD I GMRCEND D END Q
S GMRCCVT=$$UPD1 I GMRCEND D END Q
D UPDCMT(.GMRCMT)
D VERIFY I GMRCEND D END Q
D GETENTS^GMRCSTS1(GMRCSVC,GMRCSTRT,GMRCSTOP,GMRCM)
S GMRCDO=$$WHATTODO I 'GMRCDO D END Q
D DEVICE I $G(GMRCEND) D END Q
I $D(IO("Q")) D QUEUE,^%ZISC,END Q
D PRINT^GMRCSTS1(GMRCM,GMRCCVT,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP,GMRCDO)
D END Q
GETSRV ;Get a service that the user is authorized to update status for
D ^GMRCASV Q:'GMRCDG
S GMRCSVC=+GMRCDG,GMRCSVCN=$P($G(^GMR(123.5,+GMRCSVC,0)),U,1)
I $P($G(^GMR(123.5,+GMRCDG,0)),"^",4)=DUZ Q ;user has special privileges
;Check for parent service authorization
N AUTH,PARENT
I $P(^GMR(123.5,1,0),U,4)=DUZ Q
S (AUTH,PARENT)=0 F S PARENT=$O(^GMR(123.5,"APC",+GMRCDG,PARENT)) Q:'PARENT S:$P($G(^GMR(123.5,+PARENT,0)),U,4)=DUZ AUTH=PARENT
I 'AUTH D UNAUTH S GMRCDG=0 G GETSRV
Q
;
UNAUTH ;Unauthorized to do special update processing for service or its parent.
N GMRCMSG
W !
S GMRCMSG="You are not defined as the SPECIAL UPDATES INDIVIDUAL for the"
S GMRCMSG(1)=GMRCSVCN_" service or its parent service."
S GMRCDG=0
D EXAC^GMRCADC(.GMRCMSG)
Q
;
GETDTR ;Get the date range
;END=# of days (T-END) for stop default limitations
;GMRCSTRT=Start date/time
;GMRCSTOP=Stop date/time
;GMRCEND=1 if user timed out or "^"
S GMRCEND=0
N X1,X2,X,END
S X1=$$DT^XLFDT,X2=-30 D C^%DTC S END=X K X
D START Q:GMRCEND
D STOP Q:GMRCEND
Q
;
START ;Get the start date
N DIR,Y,ORDER,FIRST,GMRCIEN
S ORDER=$O(^GMR(123,"AC",0)),GMRCIEN=$O(^GMR(123,"AC",+ORDER,""))
I +$G(GMRCIEN) D
. S Y=$P($G(^GMR(123,GMRCIEN,0)),U,1)
. X ^DD("DD") S FIRST=$P(Y,"@",1)
. S DIR("B")=FIRST
. W !!,"The first order in Consults has an entry date of "_DIR("B"),!
. Q
S DIR(0)="D^:"_END_":AEX",DIR("A")="Update Status Start Date"
S DIR("?")="^D HELP^%DTC"
D ^DIR
I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!('Y)) S GMRCEND=1 Q
S GMRCSTRT=Y
Q
;
STOP ;Get the stop date
N DIR,Y,X
S DIR(0)="D^:"_END_":AEX",DIR("A")="Update Status Stop Date"
D ^DIR
I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!('Y)) S GMRCEND=1 Q
I Y<GMRCSTRT S GMRCSTOP=GMRCSTRT,GMRCSTRT=Y
E S GMRCSTOP=Y
Q
;
METHOD() ;Get method to determine which consults to change
N DIR,Y,X
;S DIR(0)="SM^P:Pending;A:Active;S:Scheduled;ALL:For All"
;S DIR("A")="Status(es) to search for updating"
S DIR("A",1)=""
S DIR("A",2)=""
S DIR("A",3)=" 1 = Pending"
S DIR("A",4)=" 2 = Active"
S DIR("A",5)=" 3 = Scheduled"
S DIR("A",6)=" 4 = All"
S DIR("A",7)=""
S DIR("A",8)=" Enter any combination of numbers separated"
S DIR("A")=" by a comma or hyphen"
S DIR(0)="LO^1:4"
D ^DIR
I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1
Q Y
S DIR(0)="SM^S:Order Status of Pending or Active;R:Result Activity"
S DIR("A")="Method to find Consults to Update"
D ^DIR
I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1 Q Y
Q Y
;
VERIFY ;Verify the criteria is correct
W !
D UPDCRIT^GMRCSTS1(GMRCCVT,GMRCM,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP)
N DIR
S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="NO"
D ^DIR I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!('Y)) S GMRCEND=1 Q
Q
UPD1() ;Determine update status
N DIR,X,Y
W !!,"If orders in the date range still have the selected status, this option"
W !,"will change their status in consults, and update the order."
W !!,"You may change the status to COMPLETE or DISCONTINUED."
W !!,"Ordering provider will not receive notification of Group Update."
W !
S DIR(0)="SAM^D:Discontinued;C:Complete"
S DIR("A")="Change their status to: "
D ^DIR I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1 Q Y
Q $S(Y="D":"1^DC",1:"2^C")
;
DEVICE ; device for printout of entries to group update
N %ZIS,POP
W !!,"The device selected will print a list of entries from file 123 that will be"
W !,"updated to ",$S(+GMRCCVT=1:"DISCONTINUED",1:"COMPLETE"),"."
W !!,"If you choose to update records, the update of the consult entries will take"
W !,"place upon completion of the report."
W !!,"It is highly advised that a printer be selected!"
RETRY S %ZIS="QM",%ZIS("A")="Select device for report: ",%ZIS("B")=""
D ^%ZIS
I POP S GMRCEND=1 Q
I $E(IOST,1,2)="C-" D G:Y<1 RETRY
. W !!,$C(7),"You have not chosen a printer! If you do not choose a printer there will",!,"be no record of the entries that were updated."
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
. S DIR(0)="Y",DIR("A")="Are you sure you want to use this device"
. S DIR("B")="NO" D ^DIR I $D(DIRUT) S GMRCEND=1
Q
QUEUE ; send task for print and update
I GMRCDO=2,'$$WARNING D ^%ZISC,END Q ; Killed report
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK
S ZTRTN="PRTTSK^GMRCSTS1",ZTDESC="UPDATE OF RECORDS FILE 123"
S ZTIO=ION
S ZTSAVE("^TMP(""GMRCLS"",$J,")="",ZTSAVE("GMRC*")=""
D ^%ZTLOAD I $G(ZTSK) W !,"Task # ",ZTSK
I '$G(ZTSK) W !,"Unable to queue report! Try again later."
Q
UPDCMT(COMMENT) ; get comment to stuff in consult activity
W !
N DWPK,DWLW,DIC,DIWEPSE,INDEX
W !,"Enter the Comment to be applied to all selected Consults"
S DIC="^TMP(""GMRCTMP"","_$J_",1,",DWLW=80,DWPK=1,DIWEPSE=1
D EN^DIWE
S INDEX=0
F S INDEX=$O(^TMP("GMRCTMP",$J,1,INDEX)) Q:'INDEX D
. S COMMENT(INDEX,0)=^TMP("GMRCTMP",$J,1,INDEX,0)
K ^TMP("GMRCTMP",$J)
Q
WHATTODO() ;how to handle the update
N DIR
S DIR(0)="SO^1:Print report only;2:Print report & update records;3:Quit"
S DIR("A")="Choose the method to handle the report"
D ^DIR I $D(DIRUT)!(Y=3) Q 0
Q +Y
WARNING() ; If REPORT/UPDATE is being task issue warning message.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
I $D(IO("Q")) D
. W !,"WARNING - Records will automatically be updated since the"
. W !,"report is being tasked.",!
S DIR("B")="NO",DIR(0)="Y",DIR("A")="Do you wish to continue??"
D ^DIR I $D(DIRUT) S Y=0
Q +Y
END K ^TMP("GMRCLS",$J) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSTS 6538 printed Dec 13, 2024@01:47:27 Page 2
GMRCSTS ;SLC/DLT,JFR,MA - Group update status of consult and order; 11/25/2000
+1 ;;3.0;CONSULT/REQUEST TRACKING;**8,18,21,76**;DEC 27, 1997;Build 7
+2 ; Patch 18 - Change UPDCMT to use Editor to add comment and
+3 ; Added Scheduled consults to selection list.
+4 ; Patch 21 - Added warning message in line tag WARNING().
+5 ; This routine invokes IA #2876,3121
+6 NEW GMRCTO,GMRCDG,GMRCSVC,GMRCSVCN,GMRCEND,GMRCSTRT,GMRCSTOP,GMRCGRP
+7 NEW GMRCCVT,GMRCM,GMRCMT,GMRCDO,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+8 DO GETSRV
IF 'GMRCDG
DO END
QUIT
+9 DO GETDTR
IF GMRCEND
DO END
QUIT
+10 SET GMRCM=$$METHOD
IF GMRCEND
DO END
QUIT
+11 SET GMRCCVT=$$UPD1
IF GMRCEND
DO END
QUIT
+12 DO UPDCMT(.GMRCMT)
+13 DO VERIFY
IF GMRCEND
DO END
QUIT
+14 DO GETENTS^GMRCSTS1(GMRCSVC,GMRCSTRT,GMRCSTOP,GMRCM)
+15 SET GMRCDO=$$WHATTODO
IF 'GMRCDO
DO END
QUIT
+16 DO DEVICE
IF $GET(GMRCEND)
DO END
QUIT
+17 IF $DATA(IO("Q"))
DO QUEUE
DO ^%ZISC
DO END
QUIT
+18 DO PRINT^GMRCSTS1(GMRCM,GMRCCVT,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP,GMRCDO)
+19 DO END
QUIT
GETSRV ;Get a service that the user is authorized to update status for
+1 DO ^GMRCASV
if 'GMRCDG
QUIT
+2 SET GMRCSVC=+GMRCDG
SET GMRCSVCN=$PIECE($GET(^GMR(123.5,+GMRCSVC,0)),U,1)
+3 ;user has special privileges
IF $PIECE($GET(^GMR(123.5,+GMRCDG,0)),"^",4)=DUZ
QUIT
+4 ;Check for parent service authorization
+5 NEW AUTH,PARENT
+6 IF $PIECE(^GMR(123.5,1,0),U,4)=DUZ
QUIT
+7 SET (AUTH,PARENT)=0
FOR
SET PARENT=$ORDER(^GMR(123.5,"APC",+GMRCDG,PARENT))
if 'PARENT
QUIT
if $PIECE($GET(^GMR(123.5,+PARENT,0)),U,4)=DUZ
SET AUTH=PARENT
+8 IF 'AUTH
DO UNAUTH
SET GMRCDG=0
GOTO GETSRV
+9 QUIT
+10 ;
UNAUTH ;Unauthorized to do special update processing for service or its parent.
+1 NEW GMRCMSG
+2 WRITE !
+3 SET GMRCMSG="You are not defined as the SPECIAL UPDATES INDIVIDUAL for the"
+4 SET GMRCMSG(1)=GMRCSVCN_" service or its parent service."
+5 SET GMRCDG=0
+6 DO EXAC^GMRCADC(.GMRCMSG)
+7 QUIT
+8 ;
GETDTR ;Get the date range
+1 ;END=# of days (T-END) for stop default limitations
+2 ;GMRCSTRT=Start date/time
+3 ;GMRCSTOP=Stop date/time
+4 ;GMRCEND=1 if user timed out or "^"
+5 SET GMRCEND=0
+6 NEW X1,X2,X,END
+7 SET X1=$$DT^XLFDT
SET X2=-30
DO C^%DTC
SET END=X
KILL X
+8 DO START
if GMRCEND
QUIT
+9 DO STOP
if GMRCEND
QUIT
+10 QUIT
+11 ;
START ;Get the start date
+1 NEW DIR,Y,ORDER,FIRST,GMRCIEN
+2 SET ORDER=$ORDER(^GMR(123,"AC",0))
SET GMRCIEN=$ORDER(^GMR(123,"AC",+ORDER,""))
+3 IF +$GET(GMRCIEN)
Begin DoDot:1
+4 SET Y=$PIECE($GET(^GMR(123,GMRCIEN,0)),U,1)
+5 XECUTE ^DD("DD")
SET FIRST=$PIECE(Y,"@",1)
+6 SET DIR("B")=FIRST
+7 WRITE !!,"The first order in Consults has an entry date of "_DIR("B"),!
+8 QUIT
End DoDot:1
+9 SET DIR(0)="D^:"_END_":AEX"
SET DIR("A")="Update Status Start Date"
+10 SET DIR("?")="^D HELP^%DTC"
+11 DO ^DIR
+12 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!('Y))
SET GMRCEND=1
QUIT
+13 SET GMRCSTRT=Y
+14 QUIT
+15 ;
STOP ;Get the stop date
+1 NEW DIR,Y,X
+2 SET DIR(0)="D^:"_END_":AEX"
SET DIR("A")="Update Status Stop Date"
+3 DO ^DIR
+4 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!('Y))
SET GMRCEND=1
QUIT
+5 IF Y<GMRCSTRT
SET GMRCSTOP=GMRCSTRT
SET GMRCSTRT=Y
+6 IF '$TEST
SET GMRCSTOP=Y
+7 QUIT
+8 ;
METHOD() ;Get method to determine which consults to change
+1 NEW DIR,Y,X
+2 ;S DIR(0)="SM^P:Pending;A:Active;S:Scheduled;ALL:For All"
+3 ;S DIR("A")="Status(es) to search for updating"
+4 SET DIR("A",1)=""
+5 SET DIR("A",2)=""
+6 SET DIR("A",3)=" 1 = Pending"
+7 SET DIR("A",4)=" 2 = Active"
+8 SET DIR("A",5)=" 3 = Scheduled"
+9 SET DIR("A",6)=" 4 = All"
+10 SET DIR("A",7)=""
+11 SET DIR("A",8)=" Enter any combination of numbers separated"
+12 SET DIR("A")=" by a comma or hyphen"
+13 SET DIR(0)="LO^1:4"
+14 DO ^DIR
+15 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
SET GMRCEND=1
+16 QUIT Y
+17 SET DIR(0)="SM^S:Order Status of Pending or Active;R:Result Activity"
+18 SET DIR("A")="Method to find Consults to Update"
+19 DO ^DIR
+20 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
SET GMRCEND=1
QUIT Y
+21 QUIT Y
+22 ;
VERIFY ;Verify the criteria is correct
+1 WRITE !
+2 DO UPDCRIT^GMRCSTS1(GMRCCVT,GMRCM,GMRCSVC,.GMRCMT,GMRCSTRT,GMRCSTOP)
+3 NEW DIR
+4 SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="NO"
+5 DO ^DIR
IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!('Y))
SET GMRCEND=1
QUIT
+6 QUIT
UPD1() ;Determine update status
+1 NEW DIR,X,Y
+2 WRITE !!,"If orders in the date range still have the selected status, this option"
+3 WRITE !,"will change their status in consults, and update the order."
+4 WRITE !!,"You may change the status to COMPLETE or DISCONTINUED."
+5 WRITE !!,"Ordering provider will not receive notification of Group Update."
+6 WRITE !
+7 SET DIR(0)="SAM^D:Discontinued;C:Complete"
+8 SET DIR("A")="Change their status to: "
+9 DO ^DIR
IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
SET GMRCEND=1
QUIT Y
+10 QUIT $SELECT(Y="D":"1^DC",1:"2^C")
+11 ;
DEVICE ; device for printout of entries to group update
+1 NEW %ZIS,POP
+2 WRITE !!,"The device selected will print a list of entries from file 123 that will be"
+3 WRITE !,"updated to ",$SELECT(+GMRCCVT=1:"DISCONTINUED",1:"COMPLETE"),"."
+4 WRITE !!,"If you choose to update records, the update of the consult entries will take"
+5 WRITE !,"place upon completion of the report."
+6 WRITE !!,"It is highly advised that a printer be selected!"
RETRY SET %ZIS="QM"
SET %ZIS("A")="Select device for report: "
SET %ZIS("B")=""
+1 DO ^%ZIS
+2 IF POP
SET GMRCEND=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+4 WRITE !!,$CHAR(7),"You have not chosen a printer! If you do not choose a printer there will",!,"be no record of the entries that were updated."
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+6 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to use this device"
+7 SET DIR("B")="NO"
DO ^DIR
IF $DATA(DIRUT)
SET GMRCEND=1
End DoDot:1
if Y<1
GOTO RETRY
+8 QUIT
QUEUE ; send task for print and update
+1 ; Killed report
IF GMRCDO=2
IF '$$WARNING
DO ^%ZISC
DO END
QUIT
+2 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK
+3 SET ZTRTN="PRTTSK^GMRCSTS1"
SET ZTDESC="UPDATE OF RECORDS FILE 123"
+4 SET ZTIO=ION
+5 SET ZTSAVE("^TMP(""GMRCLS"",$J,")=""
SET ZTSAVE("GMRC*")=""
+6 DO ^%ZTLOAD
IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK
+7 IF '$GET(ZTSK)
WRITE !,"Unable to queue report! Try again later."
+8 QUIT
UPDCMT(COMMENT) ; get comment to stuff in consult activity
+1 WRITE !
+2 NEW DWPK,DWLW,DIC,DIWEPSE,INDEX
+3 WRITE !,"Enter the Comment to be applied to all selected Consults"
+4 SET DIC="^TMP(""GMRCTMP"","_$JOB_",1,"
SET DWLW=80
SET DWPK=1
SET DIWEPSE=1
+5 DO EN^DIWE
+6 SET INDEX=0
+7 FOR
SET INDEX=$ORDER(^TMP("GMRCTMP",$JOB,1,INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+8 SET COMMENT(INDEX,0)=^TMP("GMRCTMP",$JOB,1,INDEX,0)
End DoDot:1
+9 KILL ^TMP("GMRCTMP",$JOB)
+10 QUIT
WHATTODO() ;how to handle the update
+1 NEW DIR
+2 SET DIR(0)="SO^1:Print report only;2:Print report & update records;3:Quit"
+3 SET DIR("A")="Choose the method to handle the report"
+4 DO ^DIR
IF $DATA(DIRUT)!(Y=3)
QUIT 0
+5 QUIT +Y
WARNING() ; If REPORT/UPDATE is being task issue warning message.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 WRITE !,"WARNING - Records will automatically be updated since the"
+4 WRITE !,"report is being tasked.",!
End DoDot:1
+5 SET DIR("B")="NO"
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue??"
+6 DO ^DIR
IF $DATA(DIRUT)
SET Y=0
+7 QUIT +Y
END KILL ^TMP("GMRCLS",$JOB)
QUIT
