GMRCCXDC ;ABV/MKN - Convert cancelled consults to discontinued after 31 days ;Dec 09, 2020@18:08
;;3.0;CONSULT/REQUEST TRACKING;**113,170**;DEC 27, 1997;Build 1
;
;;ICR Invoked
;;10103, ^XLFDT - $$FMADD, $$NOW
EN ;Overnight Taskman job that runs from option GMRC CHANGE STATUS X TO DC
N DA,GMRCACT,GMRCCOM,GMRCCT,GMRCCX,GMRCDA,GMRCDT1,GMRCDT2,GMRCDTMP,GMRCIEN,GMRCNA,GMRCNOW,GMRCORN
N GMRCPROV,GMRCSTOP,X,X1,X2,XTMP,XTMPCT,Y,GMRCDAX,GMRCIENX
S X=$E($$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","Is the overnight cancelled to discontinued job active?","E"))
I X="" S X=$$TRYLST()
Q:$E(X)'="Y"
S DA=$$NOW^XLFDT,X1=DA,X2=90 D C^%DTC
S XTMP=$NA(^XTMP("GMRCCXDC "_$$FMTE^XLFDT(DA,"5PZ")_" "_$J))
K @XTMP S @XTMP@(0)=X_U_DA_U_"Record of consults that were changed from ""Cancelled"" to ""Discontinued"" by overnight process GMRC CHANGE STATUS X TO DC"
I '$D(ZTQUEUED) S X="This option is only for use by TaskMan as an overnight job" D Q
.S @XTMP@(1)=X
.W !!,X,!!
S GMRCDT1=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to start with?","E")
I GMRCDT1="" S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="From Days entry not found in parameter CSLT CANCELLED TO DISCONTINUED ... job quitting..." Q
S GMRCDT2=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to end with?","E")
I GMRCDT2="" S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="To Days entry not found in parameter CSLT CANCELLED TO DISCONTINUED ... assuming "_(GMRCDT1+30) S GMRCDT2=GMRCDT1+30
;GMRC*3*170: Variable GMRCDAX used in CANC logic.
S X=$$NOW^XLFDT,X1=X,X2=-GMRCDT1 D C^%DTC S (GMRCDA,GMRCDAX)=$P(X,".")_".2399",GMRCCT=0
S X=$$NOW^XLFDT,X1=X,X2=-GMRCDT2 D C^%DTC S GMRCSTOP=$P(X,".")
S GMRCCOM(1)="ADC:Consult automatically discontinued "_GMRCDT1_" days after cancellation"
S XTMPCT=0,GMRCCX=$O(^GMR(123.1,"B","CANCELLED",""))
I 'GMRCCX S GMRCCT=GMRCCT+1,XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="""CANCELLED"" status in file #123.1 (REQUEST ACTION TYPES) not found" D G EX
.S GMRCCT=GMRCCT+1,XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="Overnight job aborting..."
F S GMRCDA=$O(^GMR(123,"ASTATUS",GMRCDA),-1) Q:GMRCDA'?1.N.".".N!(GMRCDA<GMRCSTOP) D
.S GMRCIEN="" F S GMRCIEN=$O(^GMR(123,"ASTATUS",GMRCDA,GMRCCX,GMRCIEN)) Q:'GMRCIEN D
..Q:$$GET1^DIQ(123,GMRCIEN_",",8)'="CANCELLED"
..;GMRC*3*170: check for a more recent cancellation before proceeding to discontinue
..Q:$$CANC(GMRCIEN)
..S GMRCORN=$$GET1^DIQ(123,GMRCIEN_",",.03,"I"),GMRCNA=$$GET1^DIQ(123,GMRCIEN_",",.02,"E")
..S GMRCACT="" F S GMRCACT=$O(^GMR(123,"ASTATUS",GMRCDA,GMRCCX,GMRCIEN,GMRCACT)) Q:'GMRCACT D
...S GMRCPROV=$$GET1^DIQ(123.02,GMRCACT_","_GMRCIEN_",",3,"I")
...S GMRCNOW=$$NOW^XLFDT,GMRCDTMP=GMRCDA
...S Y=$$DC^GMRCGUIA(GMRCIEN,GMRCPROV,GMRCNOW,"DC",.GMRCCOM)
...S GMRCDA=GMRCDTMP
...I '+Y S GMRCCT=GMRCCT+1,XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)=GMRCCT_". Consult #"_GMRCIEN_" Patient: "_GMRCNA_" "_$$FMTE^XLFDT(GMRCDA,"5PZ")_" has been discontinued by overnight job GMRC CHANGE STATUS X TO DC"
...E S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="Problem with discontinuing Consult #"_GMRCIEN_" Patient: "_GMRCNA_" - Result was "_Y
EX ;
S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="End of run @"_$$FMTE^XLFDT(DT,"5PZ")
S @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_". "_$S('GMRCCT:"No",GMRCCT=1:1,GMRCCT>1:GMRCCT,1:"")
S @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_" consult"_$S(GMRCCT>1!('GMRCCT):"s",1:"")
S @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_" "_$S(GMRCCT=1:"was",1:"were")_" discontinued"
ZW @XTMP
Q
;
CANC(GMRCIENX) ;check for multiple cancellations
N GMRCACTX,GMRCHITX,GMRCCANX
S GMRCACTX="A",(GMRCHITX,GMRCCANX)=0
;Search back starting with most recent activity.
F S GMRCACTX=$O(^GMR(123,GMRCIENX,40,GMRCACTX),-1) Q:'GMRCACTX Q:GMRCHITX D
. ;activity was not "cancelled", so quit
. Q:$$GET1^DIQ(123.02,GMRCACTX_","_GMRCIENX_",",1)'="CANCELLED"
. ;Search has gone past the starting date of the search, so quit since
. ;no recent cancellations have been found.
. I $$GET1^DIQ(123.02,GMRCACTX_","_GMRCIENX_",",.01,"I")'>GMRCDAX S GMRCHITX=1 Q
. ;If got this far, have found a cancellation which occurred after
. ;the cancellation found by the original search at EN+25
. S (GMRCCANX,GMRCHITX)=1
Q GMRCCANX
;
UPDPARM ;Run with menu option GMRC CX TO DC PARAMETER EDIT
N D1,D2,D3,DAY1,DAY2,DIR,DIRUT,ERR,I,N,OUT,X,X1,X2,Y
W !!,"Update the three fields in the CSLT CANCELLED TO DISCONTINUED parameter",!!
D GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
I ERR W !,"Unable to retrieve values in parameter CSLT CANCELLED TO DISCONTINUED" Q
S (D1,D2,D3,I)=0 F S I=I+1 Q:I>3 S N="" F S N=$O(OUT(N)) Q:N="" D
.I I=1,OUT(N)["Is the overnight" S D1=N
.I I=2,OUT(N)["How many days back to start" S D2=N
.I I=3,OUT(N)["How many days back to end" S D3=N
UPDACT ;
K DIR,DUOUT,DIRUT S DIR(0)="Y",DIR("A")="Is the overnight cancelled to discontinued job active"
S X=$P(OUT(D1),U,2),DIR("B")=$S($E(X)="Y":"YES",1:"NO")
D ^DIR Q:$D(DUOUT)!($D(DIRUT))
S Y=$S(Y:"Y",1:"N") D PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","Is the overnight cancelled to discontinued job active?",Y)
Q:Y="N"
;
UPDDAY1 ;
K DIR S DIR(0)="N^0:99999",DIR("A")="How many days back to start with"
S DIR("B")=$P(OUT(D2),U,2)
D ^DIR G:$D(DUOUT)!($D(DIRUT)) UPDACT
S DAY1=Y
D PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to start with?",Y)
S Y=$$FMADD^XLFDT(DT,(DAY1*-1)) W " ",$$FMTE^XLFDT(Y,"5PZ")
UPDDAY2 ;
K DIR S DIR(0)="N^"_DAY1_":999999",DIR("A")="How many days back to end with"
S DIR("B")=$P(OUT(D3),U,2)
D ^DIR G:$D(DUOUT)!($D(DIRUT)) UPDDAY1
I Y<DAY1 W !,"The end day number cannot be earlier than the start day number" G UPDDAY2
S DAY2=Y
D PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to end with?",Y)
S Y=$$FMADD^XLFDT(DT,(DAY2*-1)) W " ",$$FMTE^XLFDT(Y,"5PZ")
D GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
I ERR W !,"Unable to retrieve values in parameter CSLT CANCELLED TO DISCONTINUED" Q
W !!,"New contents of parameter:",!
W !,$P(OUT(D1),U)," = ",$P(OUT(D1),U,2)
W !,$P(OUT(D2),U)," = ",$P(OUT(D2),U,2) S Y=$$FMADD^XLFDT(DT,($P(OUT(D2),U,2)*-1)) W " ",$$FMTE^XLFDT(Y,"5PZ")
W !,$P(OUT(D3),U)," = ",$P(OUT(D3),U,2) S Y=$$FMADD^XLFDT(DT,($P(OUT(D3),U,2)*-1)) W " ",$$FMTE^XLFDT(Y,"5PZ")
Q
;
CONSCX ;Find cancelled consults
N DA,DIR,DTOUT,DUOUT,ERR,GMRCCX,GMRCDT1,GMRCDT2,I,IEN,IENACT,OUT,X,X1,X2
W !,"Search for cancelled consults"
S GMRCCX=$O(^GMR(123.1,"B","CANCELLED",""))
I 'GMRCCX W !,"""CANCELLED"" status in file #123.1 (REQUEST ACTION TYPES) not found" Q
CONSCXST ;
S DIR(0)="DA",DIR("A")="Enter Start Date for search: "
D ^DIR
I $D(DUOUT)!($D(DTOUT)) Q
S GMRCDT1=+Y I 'GMRCDT1 Q
W " ",$$FMTE^XLFDT(GMRCDT1,"5PZ")
CONSCXEN ;
S DIR(0)="DA",DIR("A")="Enter End Date for search: "
D ^DIR
I $D(DUOUT)!($D(DTOUT)) G CONSCXST
I +Y<GMRCDT1 W !,"End date may not be earlier than Start date" G CONSCXEN
W " ",$$FMTE^XLFDT(+Y,"5PZ")
S GMRCDT2=(+Y)_".2399"
S DA=GMRCDT1 F S DA=$O(^GMR(123,"ASTATUS",DA)) Q:DA=""!(DA>GMRCDT2) S IEN="" F S IEN=$O(^GMR(123,"ASTATUS",DA,GMRCCX,IEN)) Q:'IEN D
.S IENACT=0 F S IENACT=$O(^GMR(123,"ASTATUS",DA,GMRCCX,IEN,IENACT)) Q:'IENACT D
..Q:$$GET1^DIQ(123,IEN_",",8)'="CANCELLED"
..K OUT D GETS^DIQ(123,IEN_",","**","IE","OUT","ERR")
..S I=0 F S I=$O(OUT(123.02,I)) Q:'I D
...S X=$G(OUT(123.02,I,1,"I")) Q:X'=GMRCCX
...W !,$G(OUT(123.02,I,.01,"I")),?16,"Consult #: ",IEN,?35,$G(OUT(123,IEN_",",.02,"E"))
...S X1=$P(DT,"."),X2=$P($G(OUT(123.02,I,.01,"I")),".") D ^%DTC W:X " (Today -",X,")"
Q
;
TRYLST() ;
N ERR,N,OUT,R
D GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
I ERR Q ""
S (N,R)="" F S N=$O(OUT(N)) Q:N="" I OUT(N)["Is the overnight" S R=$P(OUT(N),U,2)
Q R
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCXDC 8058 printed Apr 09, 2024@20:52:21 Page 2
GMRCCXDC ;ABV/MKN - Convert cancelled consults to discontinued after 31 days ;Dec 09, 2020@18:08
+1 ;;3.0;CONSULT/REQUEST TRACKING;**113,170**;DEC 27, 1997;Build 1
+2 ;
+3 ;;ICR Invoked
+4 ;;10103, ^XLFDT - $$FMADD, $$NOW
EN ;Overnight Taskman job that runs from option GMRC CHANGE STATUS X TO DC
+1 NEW DA,GMRCACT,GMRCCOM,GMRCCT,GMRCCX,GMRCDA,GMRCDT1,GMRCDT2,GMRCDTMP,GMRCIEN,GMRCNA,GMRCNOW,GMRCORN
+2 NEW GMRCPROV,GMRCSTOP,X,X1,X2,XTMP,XTMPCT,Y,GMRCDAX,GMRCIENX
+3 SET X=$EXTRACT($$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","Is the overnight cancelled to discontinued job active?","E"))
+4 IF X=""
SET X=$$TRYLST()
+5 if $EXTRACT(X)'="Y"
QUIT
+6 SET DA=$$NOW^XLFDT
SET X1=DA
SET X2=90
DO C^%DTC
+7 SET XTMP=$NAME(^XTMP("GMRCCXDC "_$$FMTE^XLFDT(DA,"5PZ")_" "_$JOB))
+8 KILL @XTMP
SET @XTMP@(0)=X_U_DA_U_"Record of consults that were changed from ""Cancelled"" to ""Discontinued"" by overnight process GMRC CHANGE STATUS X TO DC"
+9 IF '$DATA(ZTQUEUED)
SET X="This option is only for use by TaskMan as an overnight job"
Begin DoDot:1
+10 SET @XTMP@(1)=X
+11 WRITE !!,X,!!
End DoDot:1
QUIT
+12 SET GMRCDT1=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to start with?","E")
+13 IF GMRCDT1=""
SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)="From Days entry not found in parameter CSLT CANCELLED TO DISCONTINUED ... job quitting..."
QUIT
+14 SET GMRCDT2=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to end with?","E")
+15 IF GMRCDT2=""
SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)="To Days entry not found in parameter CSLT CANCELLED TO DISCONTINUED ... assuming "_(GMRCDT1+30)
SET GMRCDT2=GMRCDT1+30
+16 ;GMRC*3*170: Variable GMRCDAX used in CANC logic.
+17 SET X=$$NOW^XLFDT
SET X1=X
SET X2=-GMRCDT1
DO C^%DTC
SET (GMRCDA,GMRCDAX)=$PIECE(X,".")_".2399"
SET GMRCCT=0
+18 SET X=$$NOW^XLFDT
SET X1=X
SET X2=-GMRCDT2
DO C^%DTC
SET GMRCSTOP=$PIECE(X,".")
+19 SET GMRCCOM(1)="ADC:Consult automatically discontinued "_GMRCDT1_" days after cancellation"
+20 SET XTMPCT=0
SET GMRCCX=$ORDER(^GMR(123.1,"B","CANCELLED",""))
+21 IF 'GMRCCX
SET GMRCCT=GMRCCT+1
SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)="""CANCELLED"" status in file #123.1 (REQUEST ACTION TYPES) not found"
Begin DoDot:1
+22 SET GMRCCT=GMRCCT+1
SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)="Overnight job aborting..."
End DoDot:1
GOTO EX
+23 FOR
SET GMRCDA=$ORDER(^GMR(123,"ASTATUS",GMRCDA),-1)
if GMRCDA'?1.N.".".N!(GMRCDA<GMRCSTOP)
QUIT
Begin DoDot:1
+24 SET GMRCIEN=""
FOR
SET GMRCIEN=$ORDER(^GMR(123,"ASTATUS",GMRCDA,GMRCCX,GMRCIEN))
if 'GMRCIEN
QUIT
Begin DoDot:2
+25 if $$GET1^DIQ(123,GMRCIEN_",",8)'="CANCELLED"
QUIT
+26 ;GMRC*3*170: check for a more recent cancellation before proceeding to discontinue
+27 if $$CANC(GMRCIEN)
QUIT
+28 SET GMRCORN=$$GET1^DIQ(123,GMRCIEN_",",.03,"I")
SET GMRCNA=$$GET1^DIQ(123,GMRCIEN_",",.02,"E")
+29 SET GMRCACT=""
FOR
SET GMRCACT=$ORDER(^GMR(123,"ASTATUS",GMRCDA,GMRCCX,GMRCIEN,GMRCACT))
if 'GMRCACT
QUIT
Begin DoDot:3
+30 SET GMRCPROV=$$GET1^DIQ(123.02,GMRCACT_","_GMRCIEN_",",3,"I")
+31 SET GMRCNOW=$$NOW^XLFDT
SET GMRCDTMP=GMRCDA
+32 SET Y=$$DC^GMRCGUIA(GMRCIEN,GMRCPROV,GMRCNOW,"DC",.GMRCCOM)
+33 SET GMRCDA=GMRCDTMP
+34 IF '+Y
SET GMRCCT=GMRCCT+1
SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)=GMRCCT_". Consult #"_GMRCIEN_" Patient: "_GMRCNA_" "_$$FMTE^XLFDT(GMRCDA,"5PZ")_" has been discontinued by overnight job GMRC CHANGE STATUS X TO DC"
+35 IF '$TEST
SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)="Problem with discontinuing Consult #"_GMRCIEN_" Patient: "_GMRCNA_" - Result was "_Y
End DoDot:3
End DoDot:2
End DoDot:1
EX ;
+1 SET XTMPCT=XTMPCT+1
SET @XTMP@(XTMPCT)="End of run @"_$$FMTE^XLFDT(DT,"5PZ")
+2 SET @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_". "_$SELECT('GMRCCT:"No",GMRCCT=1:1,GMRCCT>1:GMRCCT,1:"")
+3 SET @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_" consult"_$SELECT(GMRCCT>1!('GMRCCT):"s",1:"")
+4 SET @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_" "_$SELECT(GMRCCT=1:"was",1:"were")_" discontinued"
+5
*** ERROR ***
+6 QUIT
+7 ;
CANC(GMRCIENX) ;check for multiple cancellations
+1 NEW GMRCACTX,GMRCHITX,GMRCCANX
+2 SET GMRCACTX="A"
SET (GMRCHITX,GMRCCANX)=0
+3 ;Search back starting with most recent activity.
+4 FOR
SET GMRCACTX=$ORDER(^GMR(123,GMRCIENX,40,GMRCACTX),-1)
if 'GMRCACTX
QUIT
if GMRCHITX
QUIT
Begin DoDot:1
+5 ;activity was not "cancelled", so quit
+6 if $$GET1^DIQ(123.02,GMRCACTX_","_GMRCIENX_",",1)'="CANCELLED"
QUIT
+7 ;Search has gone past the starting date of the search, so quit since
+8 ;no recent cancellations have been found.
+9 IF $$GET1^DIQ(123.02,GMRCACTX_","_GMRCIENX_",",.01,"I")'>GMRCDAX
SET GMRCHITX=1
QUIT
+10 ;If got this far, have found a cancellation which occurred after
+11 ;the cancellation found by the original search at EN+25
+12 SET (GMRCCANX,GMRCHITX)=1
End DoDot:1
+13 QUIT GMRCCANX
+14 ;
UPDPARM ;Run with menu option GMRC CX TO DC PARAMETER EDIT
+1 NEW D1,D2,D3,DAY1,DAY2,DIR,DIRUT,ERR,I,N,OUT,X,X1,X2,Y
+2 WRITE !!,"Update the three fields in the CSLT CANCELLED TO DISCONTINUED parameter",!!
+3 DO GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
+4 IF ERR
WRITE !,"Unable to retrieve values in parameter CSLT CANCELLED TO DISCONTINUED"
QUIT
+5 SET (D1,D2,D3,I)=0
FOR
SET I=I+1
if I>3
QUIT
SET N=""
FOR
SET N=$ORDER(OUT(N))
if N=""
QUIT
Begin DoDot:1
+6 IF I=1
IF OUT(N)["Is the overnight"
SET D1=N
+7 IF I=2
IF OUT(N)["How many days back to start"
SET D2=N
+8 IF I=3
IF OUT(N)["How many days back to end"
SET D3=N
End DoDot:1
UPDACT ;
+1 KILL DIR,DUOUT,DIRUT
SET DIR(0)="Y"
SET DIR("A")="Is the overnight cancelled to discontinued job active"
+2 SET X=$PIECE(OUT(D1),U,2)
SET DIR("B")=$SELECT($EXTRACT(X)="Y":"YES",1:"NO")
+3 DO ^DIR
if $DATA(DUOUT)!($DATA(DIRUT))
QUIT
+4 SET Y=$SELECT(Y:"Y",1:"N")
DO PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","Is the overnight cancelled to discontinued job active?",Y)
+5 if Y="N"
QUIT
+6 ;
UPDDAY1 ;
+1 KILL DIR
SET DIR(0)="N^0:99999"
SET DIR("A")="How many days back to start with"
+2 SET DIR("B")=$PIECE(OUT(D2),U,2)
+3 DO ^DIR
if $DATA(DUOUT)!($DATA(DIRUT))
GOTO UPDACT
+4 SET DAY1=Y
+5 DO PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to start with?",Y)
+6 SET Y=$$FMADD^XLFDT(DT,(DAY1*-1))
WRITE " ",$$FMTE^XLFDT(Y,"5PZ")
UPDDAY2 ;
+1 KILL DIR
SET DIR(0)="N^"_DAY1_":999999"
SET DIR("A")="How many days back to end with"
+2 SET DIR("B")=$PIECE(OUT(D3),U,2)
+3 DO ^DIR
if $DATA(DUOUT)!($DATA(DIRUT))
GOTO UPDDAY1
+4 IF Y<DAY1
WRITE !,"The end day number cannot be earlier than the start day number"
GOTO UPDDAY2
+5 SET DAY2=Y
+6 DO PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to end with?",Y)
+7 SET Y=$$FMADD^XLFDT(DT,(DAY2*-1))
WRITE " ",$$FMTE^XLFDT(Y,"5PZ")
+8 DO GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
+9 IF ERR
WRITE !,"Unable to retrieve values in parameter CSLT CANCELLED TO DISCONTINUED"
QUIT
+10 WRITE !!,"New contents of parameter:",!
+11 WRITE !,$PIECE(OUT(D1),U)," = ",$PIECE(OUT(D1),U,2)
+12 WRITE !,$PIECE(OUT(D2),U)," = ",$PIECE(OUT(D2),U,2)
SET Y=$$FMADD^XLFDT(DT,($PIECE(OUT(D2),U,2)*-1))
WRITE " ",$$FMTE^XLFDT(Y,"5PZ")
+13 WRITE !,$PIECE(OUT(D3),U)," = ",$PIECE(OUT(D3),U,2)
SET Y=$$FMADD^XLFDT(DT,($PIECE(OUT(D3),U,2)*-1))
WRITE " ",$$FMTE^XLFDT(Y,"5PZ")
+14 QUIT
+15 ;
CONSCX ;Find cancelled consults
+1 NEW DA,DIR,DTOUT,DUOUT,ERR,GMRCCX,GMRCDT1,GMRCDT2,I,IEN,IENACT,OUT,X,X1,X2
+2 WRITE !,"Search for cancelled consults"
+3 SET GMRCCX=$ORDER(^GMR(123.1,"B","CANCELLED",""))
+4 IF 'GMRCCX
WRITE !,"""CANCELLED"" status in file #123.1 (REQUEST ACTION TYPES) not found"
QUIT
CONSCXST ;
+1 SET DIR(0)="DA"
SET DIR("A")="Enter Start Date for search: "
+2 DO ^DIR
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+4 SET GMRCDT1=+Y
IF 'GMRCDT1
QUIT
+5 WRITE " ",$$FMTE^XLFDT(GMRCDT1,"5PZ")
CONSCXEN ;
+1 SET DIR(0)="DA"
SET DIR("A")="Enter End Date for search: "
+2 DO ^DIR
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO CONSCXST
+4 IF +Y<GMRCDT1
WRITE !,"End date may not be earlier than Start date"
GOTO CONSCXEN
+5 WRITE " ",$$FMTE^XLFDT(+Y,"5PZ")
+6 SET GMRCDT2=(+Y)_".2399"
+7 SET DA=GMRCDT1
FOR
SET DA=$ORDER(^GMR(123,"ASTATUS",DA))
if DA=""!(DA>GMRCDT2)
QUIT
SET IEN=""
FOR
SET IEN=$ORDER(^GMR(123,"ASTATUS",DA,GMRCCX,IEN))
if 'IEN
QUIT
Begin DoDot:1
+8 SET IENACT=0
FOR
SET IENACT=$ORDER(^GMR(123,"ASTATUS",DA,GMRCCX,IEN,IENACT))
if 'IENACT
QUIT
Begin DoDot:2
+9 if $$GET1^DIQ(123,IEN_",",8)'="CANCELLED"
QUIT
+10 KILL OUT
DO GETS^DIQ(123,IEN_",","**","IE","OUT","ERR")
+11 SET I=0
FOR
SET I=$ORDER(OUT(123.02,I))
if 'I
QUIT
Begin DoDot:3
+12 SET X=$GET(OUT(123.02,I,1,"I"))
if X'=GMRCCX
QUIT
+13 WRITE !,$GET(OUT(123.02,I,.01,"I")),?16,"Consult #: ",IEN,?35,$GET(OUT(123,IEN_",",.02,"E"))
+14 SET X1=$PIECE(DT,".")
SET X2=$PIECE($GET(OUT(123.02,I,.01,"I")),".")
DO ^%DTC
if X
WRITE " (Today -",X,")"
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
TRYLST() ;
+1 NEW ERR,N,OUT,R
+2 DO GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
+3 IF ERR
QUIT ""
+4 SET (N,R)=""
FOR
SET N=$ORDER(OUT(N))
if N=""
QUIT
IF OUT(N)["Is the overnight"
SET R=$PIECE(OUT(N),U,2)
+5 QUIT R
+6 ;
