- 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 Feb 18, 2025@23:13:50 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
