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

RA27PST.m

Go to the documentation of this file. 
  1. RA27PST ;HIRMFO/SWM - Clean up after Patch RA*5.0*27 ;12/28/01  14:06
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;**27**;Mar 16, 1998
  1.  ; *** Delete duplicate Clinical History from file #74 ***
  1.  ;
  1. QOFF ;Post-Install queues off clean-up job
  1.  I '$D(XPDNM)#2 W !!,"** This entry point must be called from KIDS installation **",!! Q
  1.  N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN S ZTIO=""
  1.  S ZTRTN="EN^RA27PST"
  1.  S ZTDESC="RA*5.0*27 Cleanup Duplicate Clin. Hist. from File 74"
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0) ;add 2 minutes to 'now'
  1.  D ^%ZTLOAD S RATXT(1)=" "
  1.  S RATXT(2)="RA*5.0*27 cleanup is running in background."
  1.  S:$G(ZTSK)>0 RATXT(3)="Task: "_ZTSK_"." D MES^XPDUTL(.RATXT)
  1.  Q
  1. MANUAL ;manually queue off clean-up job, only needed if post-install abends
  1.  ;^XTMP("RA-RA27PST",0)=60days later^date+time this was 1st run^description^subsequent date+time this was run (overwritten each subsequent time)
  1.  I +$G(DUZ)=0 W !!?5,"** DUZ is required!  Nothing done.  **",!! Q
  1.  N RA1 S RA1=""
  1.  I $D(^XTMP("RA-RA27PST",0))#2 S RA1=^(0)
  1.  I RA1="" W !,"This clean-up was either never queued off by the Installation of RA*5.0*27,",!,"or it had been completed over 60 days ago.",!! G ASKQ
  1.  I $P(RA1,"^",4)]"" S Y=$P(RA1,"^",4) D DD^%DT W !!?2,"MANUAL^RA27PST was done previously on ",Y,!!
  1.  I $P(RA1,"^",4)="" S Y=$P(RA1,"^",2) D DD^%DT W !!?2,"The installation of RA*5*27 tasked this job on ",Y,!?2,"but the job abended.",!!
  1.  I $G(^XTMP("RA-RA27PST","LAST"))="DONE" W !,"This clean-up was completed. You do not have to queue it again.",!! Q
  1. ASKQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  S DIR("?")="Enter 'Y' if you want to queue the clean-up of duplicate Clin. History for File #74."
  1.  S DIR("A")="Do you want to continue the clean-up from patch RA*5.0*27"
  1.  D ^DIR
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  Q:'Y  ;don't queue if answer is NO
  1.  N ZTDESC,ZTDTH,ZTIO,ZTRTN S ZTIO=""
  1.  S ZTRTN="EN^RA27PST"
  1.  S ZTDESC="MANUAL Cleanup Duplicate Clin. Hist. from File 74, (RA*5*27 post-install)"
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0) ;add 2 minutes to 'now'
  1.  D ^%ZTLOAD
  1.  W !?2,"RA*5.0*27 cleanup will start in 2 minutes in the background."
  1.  I $G(ZTSK)>0 W !?2,"Task: "_ZTSK_".",!!
  1.  Q
  1.  ;
  1. EN ; delete duplicate clinical history from file 74
  1.  S ZTREQ="@" ; delete from the task global
  1.  N %,RA70,RA701,RA74,RACNT,RAD0,RADFN,RADTI,RADELCNT,RADUPCNT
  1.  N RACNI,RACN,RACNT,RADUPHX,RANODE,RAOK,RAPOINT,RAX,RAX1
  1.  N RA1,RA2,RA3
  1.  S RA1="To IRM staff:"
  1.  S RA2=" If this routine abends, you may get the current count"
  1.  S RA3=" of records processed by listing ^XTMP(""RA-RA27PST"" "
  1.  S ^XTMP("RA-RA27PST",.1)="  Here are the counts from the post-install cleanup."
  1.  S ^XTMP("RA-RA27PST",.2)=" "
  1.  D INIT
  1.  I RAPOINT="DONE" S ^XTMP("RA-RA27PST",.1)="Already done previously.  No need to continue.",^(.3)="----- Previous results are repeated below: ----- ",^(.4)="" D MAIL Q
  1.  S RAD0=+RAPOINT
  1.  F  S RAD0=$O(^RARPT(RAD0)) Q:'RAD0  D CHKHX D:RADUPHX DELHX S ^XTMP("RA-RA27PST","LAST")=RAD0,RACNT=RACNT+1,$P(^XTMP("RA-RA27PST",.5),"^")=RACNT
  1.  ; increment "LAST" and RACNT  after  chkhx and delhx
  1.  D FINISH
  1.  D MAIL
  1.  Q
  1. CHKHX ; Check  History between  file 70 and 74.
  1.  ; Returns RADUPHX  1 = Duplicate
  1.  ;                  0 = Different
  1.  S RADUPHX=0
  1.  I '$O(^RARPT(RAD0,"H",0)) Q  ;default to 0 to skip DELHX since no data
  1.  S RANODE=$G(^RARPT(RAD0,0)) Q:RANODE=""
  1.  S RADFN=$P(RANODE,"^",2),RADTI=9999999.9999-$P(RANODE,"^",3)
  1.  S RACN=$P(RANODE,"^",4)
  1.  Q:'RADFN!('RADTI)!('RACN)
  1.  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
  1.  Q:'RACNI
  1.  S RA74=$O(^RARPT(RAD0,"H",""),-1)
  1.  S RA70=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",""),-1),RA701=$O(^(0))
  1.  Q:RA70=0  Q:RA701=""  ;no history in exam record
  1.  S RAX=RA74-RA70+1 Q:RAX'=1  ;different total lines
  1.  ; same total lines, so check line by line
  1.  ; RAOK=1 all lines match, =0 at least 1 difference
  1.  S RAOK=1
  1.  F RAX1=RA701:1:RA70 I ^RARPT(RAD0,"H",RAX1,0)'=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX1,0) S RAOK=0 Q
  1.  I 'RAOK Q
  1.  S RADUPCNT=RADUPCNT+1
  1.  S $P(^XTMP("RA-RA27PST",.6),"^")=RADUPCNT
  1.  I $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)'=RAD0 D MSG1 Q  ;exam not pointing to this report, so skip this report
  1.  S RADUPHX=1
  1.  Q
  1. DELHX ; delete history portion from this report
  1.  L +^RARPT(RAD0):0 I '$T D MSG2 Q
  1.  K ^RARPT(RAD0,"H")
  1.  L -^RARPT(RAD0)
  1.  S RADELCNT=RADELCNT+1
  1.  S $P(^XTMP("RA-RA27PST",.7),"^")=RADELCNT
  1.  Q
  1. MSG1 ;
  1.  S ^XTMP("RA-RA27PST",RAD0)=$P(RANODE,"^")_" ien="_RAD0_" but",^XTMP("RA-RA27PST",(RAD0+.1))=" ^RADPT("_RADFN_",""DT"","_RADTI_",""P"","_RACNI_",0)'s 17th piece="_$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
  1.  Q
  1. MSG2 ;
  1.  S ^XTMP("RA-RA27PST",RAD0)=$P(RANODE,"^")_" locked by another process."
  1.  Q
  1. INIT ; set point of latest ien processed
  1.  N %,%H,%I,%T,X,Y,RANOW
  1.  D NOW^%DTC S RANOW=% ;output NOW's dt+tm is in var %
  1.  I $D(^XTMP("RA-RA27PST",0))#2 S $P(^(0),"^",4)=RANOW,RAPOINT=^("LAST"),RACNT=+^(.5),RADUPCNT=+^(.6),RADELCNT=+^(.7) Q
  1.  S (RACNT,RADELCNT,RADUPCNT,RAPOINT)=0
  1.  S X1=RANOW,X2=60 D C^%DTC ;add 60 days to RANOW, output is X
  1.  S ^XTMP("RA-RA27PST",0)=X_"^"_RANOW_"^"_"RA*5*27 POST-INSTALL"
  1.  S ^XTMP("RA-RA27PST","LAST")=0
  1.  S ^XTMP("RA-RA27PST",.5)="^ reports processed"
  1.  S ^XTMP("RA-RA27PST",.6)="^ reports with dupl history"
  1.  S ^XTMP("RA-RA27PST",.7)="^ reports had dupl history purged"
  1.  Q
  1. FINISH ; all done
  1.  S ^XTMP("RA-RA27PST","LAST")="DONE"
  1.  S ^XTMP("RA-RA27PST",.8)=" "
  1.  S ^XTMP("RA-RA27PST",.81)="  The cleanup finished."
  1.  S ^XTMP("RA-RA27PST",.82)=" "
  1.  I $O(^XTMP("RA-RA27PST",.99)) S ^XTMP("RA-RA27PST",.83)="The following reports' history was not purged:",^(.84)=" "
  1.  Q
  1. MAIL ; Send mail message to the installer
  1.  N XMDUZ,XMSUB,XMTEXT,XMY S XMDUZ=.5
  1.  S XMTEXT="^XTMP(""RA-RA27PST""," ;only numeric nodes are mailed
  1.  S XMSUB="Results from patch RA*5*27's post-install rtn RA27PST"
  1.  S XMY(DUZ)="" D ^XMD
  1.  Q