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

GMRCCXDC.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;;ICR Invoked
  1.  ;;10103, ^XLFDT - $$FMADD, $$NOW
  1. EN ;Overnight Taskman job that runs from option GMRC CHANGE STATUS X TO DC
  1.  N DA,GMRCACT,GMRCCOM,GMRCCT,GMRCCX,GMRCDA,GMRCDT1,GMRCDT2,GMRCDTMP,GMRCIEN,GMRCNA,GMRCNOW,GMRCORN
  1.  N GMRCPROV,GMRCSTOP,X,X1,X2,XTMP,XTMPCT,Y,GMRCDAX,GMRCIENX
  1.  S X=$E($$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","Is the overnight cancelled to discontinued job active?","E"))
  1.  I X="" S X=$$TRYLST()
  1.  Q:$E(X)'="Y"
  1.  S DA=$$NOW^XLFDT,X1=DA,X2=90 D C^%DTC
  1.  S XTMP=$NA(^XTMP("GMRCCXDC "_$$FMTE^XLFDT(DA,"5PZ")_" "_$J))
  1.  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"
  1.  I '$D(ZTQUEUED) S X="This option is only for use by TaskMan as an overnight job" D  Q
  1.  .S @XTMP@(1)=X
  1.  .W !!,X,!!
  1.  S GMRCDT1=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to start with?","E")
  1.  I GMRCDT1="" S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="From Days entry not found in parameter CSLT CANCELLED TO DISCONTINUED ... job quitting..." Q
  1.  S GMRCDT2=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to end with?","E")
  1.  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
  1.  ;GMRC*3*170: Variable GMRCDAX used in CANC logic.
  1.  S X=$$NOW^XLFDT,X1=X,X2=-GMRCDT1 D C^%DTC S (GMRCDA,GMRCDAX)=$P(X,".")_".2399",GMRCCT=0
  1.  S X=$$NOW^XLFDT,X1=X,X2=-GMRCDT2 D C^%DTC S GMRCSTOP=$P(X,".")
  1.  S GMRCCOM(1)="ADC:Consult automatically discontinued "_GMRCDT1_" days after cancellation"
  1.  S XTMPCT=0,GMRCCX=$O(^GMR(123.1,"B","CANCELLED",""))
  1.  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
  1.  .S GMRCCT=GMRCCT+1,XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="Overnight job aborting..."
  1.  F  S GMRCDA=$O(^GMR(123,"ASTATUS",GMRCDA),-1) Q:GMRCDA'?1.N.".".N!(GMRCDA<GMRCSTOP)  D
  1.  .S GMRCIEN="" F  S GMRCIEN=$O(^GMR(123,"ASTATUS",GMRCDA,GMRCCX,GMRCIEN)) Q:'GMRCIEN  D
  1.  ..Q:$$GET1^DIQ(123,GMRCIEN_",",8)'="CANCELLED"
  1.  ..;GMRC*3*170: check for a more recent cancellation before proceeding to discontinue
  1.  ..Q:$$CANC(GMRCIEN)
  1.  ..S GMRCORN=$$GET1^DIQ(123,GMRCIEN_",",.03,"I"),GMRCNA=$$GET1^DIQ(123,GMRCIEN_",",.02,"E")
  1.  ..S GMRCACT="" F  S GMRCACT=$O(^GMR(123,"ASTATUS",GMRCDA,GMRCCX,GMRCIEN,GMRCACT)) Q:'GMRCACT  D
  1.  ...S GMRCPROV=$$GET1^DIQ(123.02,GMRCACT_","_GMRCIEN_",",3,"I")
  1.  ...S GMRCNOW=$$NOW^XLFDT,GMRCDTMP=GMRCDA
  1.  ...S Y=$$DC^GMRCGUIA(GMRCIEN,GMRCPROV,GMRCNOW,"DC",.GMRCCOM)
  1.  ...S GMRCDA=GMRCDTMP
  1.  ...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"
  1.  ...E  S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="Problem with discontinuing Consult #"_GMRCIEN_" Patient: "_GMRCNA_" - Result was "_Y
  1. EX ;
  1.  S XTMPCT=XTMPCT+1,@XTMP@(XTMPCT)="End of run @"_$$FMTE^XLFDT(DT,"5PZ")
  1.  S @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_". "_$S('GMRCCT:"No",GMRCCT=1:1,GMRCCT>1:GMRCCT,1:"")
  1.  S @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_" consult"_$S(GMRCCT>1!('GMRCCT):"s",1:"")
  1.  S @XTMP@(XTMPCT)=@XTMP@(XTMPCT)_" "_$S(GMRCCT=1:"was",1:"were")_" discontinued"
  1.  ZW @XTMP
  1.  Q
  1.  ;
  1. CANC(GMRCIENX) ;check for multiple cancellations
  1.  N GMRCACTX,GMRCHITX,GMRCCANX
  1.  S GMRCACTX="A",(GMRCHITX,GMRCCANX)=0
  1.  ;Search back starting with most recent activity.
  1.  F  S GMRCACTX=$O(^GMR(123,GMRCIENX,40,GMRCACTX),-1) Q:'GMRCACTX  Q:GMRCHITX  D
  1.  . ;activity was not "cancelled", so quit
  1.  . Q:$$GET1^DIQ(123.02,GMRCACTX_","_GMRCIENX_",",1)'="CANCELLED"
  1.  . ;Search has gone past the starting date of the search, so quit since
  1.  . ;no recent cancellations have been found.
  1.  . I $$GET1^DIQ(123.02,GMRCACTX_","_GMRCIENX_",",.01,"I")'>GMRCDAX S GMRCHITX=1 Q
  1.  . ;If got this far, have found a cancellation which occurred after
  1.  . ;the cancellation found by the original search at EN+25
  1.  . S (GMRCCANX,GMRCHITX)=1
  1.  Q GMRCCANX
  1.  ;
  1. UPDPARM ;Run with menu option GMRC CX TO DC PARAMETER EDIT
  1.  N D1,D2,D3,DAY1,DAY2,DIR,DIRUT,ERR,I,N,OUT,X,X1,X2,Y
  1.  W !!,"Update the three fields in the CSLT CANCELLED TO DISCONTINUED parameter",!!
  1.  D GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
  1.  I ERR W !,"Unable to retrieve values in parameter CSLT CANCELLED TO DISCONTINUED" Q
  1.  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
  1.  .I I=1,OUT(N)["Is the overnight" S D1=N
  1.  .I I=2,OUT(N)["How many days back to start" S D2=N
  1.  .I I=3,OUT(N)["How many days back to end" S D3=N
  1. UPDACT ;
  1.  K DIR,DUOUT,DIRUT S DIR(0)="Y",DIR("A")="Is the overnight cancelled to discontinued job active"
  1.  S X=$P(OUT(D1),U,2),DIR("B")=$S($E(X)="Y":"YES",1:"NO")
  1.  D ^DIR Q:$D(DUOUT)!($D(DIRUT))
  1.  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)
  1.  Q:Y="N"
  1.  ;
  1. UPDDAY1 ;
  1.  K DIR S DIR(0)="N^0:99999",DIR("A")="How many days back to start with"
  1.  S DIR("B")=$P(OUT(D2),U,2)
  1.  D ^DIR G:$D(DUOUT)!($D(DIRUT)) UPDACT
  1.  S DAY1=Y
  1.  D PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to start with?",Y)
  1.  S Y=$$FMADD^XLFDT(DT,(DAY1*-1)) W "  ",$$FMTE^XLFDT(Y,"5PZ")
  1. UPDDAY2 ;
  1.  K DIR S DIR(0)="N^"_DAY1_":999999",DIR("A")="How many days back to end with"
  1.  S DIR("B")=$P(OUT(D3),U,2)
  1.  D ^DIR G:$D(DUOUT)!($D(DIRUT)) UPDDAY1
  1.  I Y<DAY1 W !,"The end day number cannot be earlier than the start day number" G UPDDAY2
  1.  S DAY2=Y
  1.  D PUT^XPAR("PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED","How many days back to end with?",Y)
  1.  S Y=$$FMADD^XLFDT(DT,(DAY2*-1)) W "  ",$$FMTE^XLFDT(Y,"5PZ")
  1.  D GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
  1.  I ERR W !,"Unable to retrieve values in parameter CSLT CANCELLED TO DISCONTINUED" Q
  1.  W !!,"New contents of parameter:",!
  1.  W !,$P(OUT(D1),U)," = ",$P(OUT(D1),U,2)
  1.  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")
  1.  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")
  1.  Q
  1.  ;
  1. CONSCX ;Find cancelled consults
  1.  N DA,DIR,DTOUT,DUOUT,ERR,GMRCCX,GMRCDT1,GMRCDT2,I,IEN,IENACT,OUT,X,X1,X2
  1.  W !,"Search for cancelled consults"
  1.  S GMRCCX=$O(^GMR(123.1,"B","CANCELLED",""))
  1.  I 'GMRCCX W !,"""CANCELLED"" status in file #123.1 (REQUEST ACTION TYPES) not found" Q
  1. CONSCXST ;
  1.  S DIR(0)="DA",DIR("A")="Enter Start Date for search: "
  1.  D ^DIR
  1.  I $D(DUOUT)!($D(DTOUT)) Q
  1.  S GMRCDT1=+Y I 'GMRCDT1 Q
  1.  W "  ",$$FMTE^XLFDT(GMRCDT1,"5PZ")
  1. CONSCXEN ;
  1.  S DIR(0)="DA",DIR("A")="Enter End Date for search: "
  1.  D ^DIR
  1.  I $D(DUOUT)!($D(DTOUT)) G CONSCXST
  1.  I +Y<GMRCDT1 W !,"End date may not be earlier than Start date" G CONSCXEN
  1.  W "  ",$$FMTE^XLFDT(+Y,"5PZ")
  1.  S GMRCDT2=(+Y)_".2399"
  1.  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
  1.  .S IENACT=0 F  S IENACT=$O(^GMR(123,"ASTATUS",DA,GMRCCX,IEN,IENACT)) Q:'IENACT  D
  1.  ..Q:$$GET1^DIQ(123,IEN_",",8)'="CANCELLED"
  1.  ..K OUT D GETS^DIQ(123,IEN_",","**","IE","OUT","ERR")
  1.  ..S I=0 F  S I=$O(OUT(123.02,I)) Q:'I  D
  1.  ...S X=$G(OUT(123.02,I,1,"I")) Q:X'=GMRCCX
  1.  ...W !,$G(OUT(123.02,I,.01,"I")),?16,"Consult #: ",IEN,?35,$G(OUT(123,IEN_",",.02,"E"))
  1.  ...S X1=$P(DT,"."),X2=$P($G(OUT(123.02,I,.01,"I")),".") D ^%DTC W:X "  (Today -",X,")"
  1.  Q
  1.  ;
  1. TRYLST() ;
  1.  N ERR,N,OUT,R
  1.  D GETLST^XPAR(.OUT,"PKG.CONSULT/REQUEST TRACKING","CSLT CANCELLED TO DISCONTINUED",.ERR)
  1.  I ERR Q ""
  1.  S (N,R)="" F  S N=$O(OUT(N)) Q:N=""  I OUT(N)["Is the overnight" S R=$P(OUT(N),U,2)
  1.  Q R
  1.  ;