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

PXICLN9B.m

Go to the documentation of this file. 
  1. PXICLN9B ;ISL/dee - Cleanup routine for PX*1.0*9 ;11/8/96
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**9**;Aug 12, 1996
  1.  ;
  1. CLEANUP ;
  1.  N PXICLN9 S PXICLN9=1 ;Flag that this job is running.
  1.  N PXIVSIT,PXIVDT,PXICPT,PXIFILE,PXIVFILE,PXIVIEN,PXICNT
  1.  N PXINODE,VSIT,PXINVSIT,PXITVSIT,PXIDEL
  1.  N PXITDUP,PXITCNT,PXITNODE
  1.  N PXISOR,PXIPKG,PXIHLOC,PXIOE
  1.  ;
  1.  ;Set up package and source for Rad and Lab
  1.  S PXISOR(1)=$$SOURCE^PXAPIUTL("RAD/NUC MED")
  1.  S PXISOR(2)=$$SOURCE^PXAPIUTL("LAB DATA")
  1.  S PXIPKG(1)=$$PKG2IEN^VSIT("RA")
  1.  S PXIPKG(2)=$$PKG2IEN^VSIT("LR")
  1.  S PXIPKG(0)="~"_PXIPKG(1)_"~"_PXIPKG(2)_"~"
  1.  ;
  1.  ;get clinic for lab data
  1.  S PXIHLOC(2)=+$G(^LAB(69.9,1,.8))
  1.  ;
  1.  I $D(^TMP("PXICLN9")) D
  1.  . ;save data from where tasked errored out
  1.  . K ^TMP("PXK",$J)
  1.  . M ^TMP("PXK",$J)=^TMP("PXICLN9")
  1.  . K ^TMP("PXICLN9")
  1.  . D EN1^PXKMAIN
  1.  . K ^TMP("PXK",$J)
  1.  . D EVENT^PXKMAIN
  1.  ;
  1.  ;Where to start?
  1.  S PXIVSIT=+$G(^PX(815,1,"PATCH"))
  1.  I PXIVSIT<1 D
  1.  . S PXIVSIT=$O(^AUPNVSIT("A"),-1)
  1.  . I PXIVSIT>0 S PXIVSIT=PXIVSIT+1
  1.  . E  S PXIVSIT=0
  1.  . S $P(^PX(815,1,"PATCH"),"^",1)=PXIVSIT
  1.  ;
  1.  ;*R "Visit ien: ",PXIVSIT ;*
  1.  ;*D  ;*
  1.  F  S PXIVSIT=$O(^AUPNVSIT(PXIVSIT),-1) Q:'PXIVSIT  D
  1.  . S PXICPT=$O(^AUPNVCPT("AD",PXIVSIT,0))
  1.  . S PXIPRV=$O(^AUPNVPRV("AD",PXIVSIT,0))
  1.  . I PXICPT S PXIPKG=$P($G(^AUPNVCPT(+PXICPT,812)),"^",2)
  1.  . E  S PXIPKG=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",2)
  1.  . ;
  1.  . ;Rad or Lab ?
  1.  . I (PXICPT!PXIPRV),PXIPKG(0)[("~"_PXIPKG_"~") D
  1.  .. K ^TMP("PXICLN9")
  1.  .. ;
  1.  .. ;Copy visit
  1.  .. S PXINODE=""
  1.  .. F  S PXINODE=$O(^AUPNVSIT(PXIVSIT,PXINODE)) Q:PXINODE=""  D
  1.  ... S ^TMP("PXICLN9","VST",1,PXINODE,"AFTER")=^AUPNVSIT(PXIVSIT,PXINODE)
  1.  ... S ^TMP("PXICLN9","VST",1,PXINODE,"BEFORE")=""
  1.  .. S ^TMP("PXICLN9","VST",1,"IEN")=""
  1.  .. ;Set sum stuff need by PXK
  1.  .. S $P(^TMP("PXICLN9","VST",1,150,"AFTER"),"^",3)="A"
  1.  .. S $P(^TMP("PXICLN9","VST",1,0,"AFTER"),"^",8)=""
  1.  .. S ^TMP("PXICLN9","PKG")=PXIPKG
  1.  .. ;
  1.  .. ;Rad?
  1.  .. I PXIPKG(1)=PXIPKG D
  1.  ... S ^TMP("PXICLN9","SOR")=PXISOR(1)
  1.  ... S $P(^TMP("PXICLN9","VST",1,812,"AFTER"),"^",3)=PXISOR(1)
  1.  ... S PXISOR=PXISOR(1)
  1.  ... S PXIHLOC=$P($$RADLOC($P(^TMP("PXICLN9","VST",1,0,"AFTER"),"^",5),$P(^TMP("PXICLN9","VST",1,0,"AFTER"),"^",1)),"^",2)
  1.  .. ;Lab?
  1.  .. E  D
  1.  ... S ^TMP("PXICLN9","SOR")=PXISOR(2)
  1.  ... S $P(^TMP("PXICLN9","VST",1,812,"AFTER"),"^",3)=PXISOR(2)
  1.  ... S PXISOR=PXISOR(2)
  1.  ... S PXIHLOC=PXIHLOC(2)
  1.  .. ;
  1.  .. ;check if the hospital location was ok if it is see if visit needs
  1.  .. ;edit and quit
  1.  .. I PXIHLOC>0,$P(^TMP("PXICLN9","VST",1,0,"AFTER"),"^",22)=PXIHLOC D  Q
  1.  ... K VSIT
  1.  ... I $P(^TMP("PXICLN9","VST",1,0,"AFTER"),"^",7)'="X" S VSIT("SVC")="X"
  1.  ... I $P(^TMP("PXICLN9","VST",1,150,"AFTER"),"^",3)'="A" S VSIT("PRI")="A"
  1.  ... I $P(^TMP("PXICLN9","VST",1,812,"AFTER"),"^",3)'=PXISOR S VSIT("SOR")=PXISOR
  1.  ... Q:'$D(VSIT) 
  1.  ... S VSIT("IEN")=PXIVSIT
  1.  ... D UPD^VSIT
  1.  .. ;
  1.  .. S:PXIHLOC>0 $P(^TMP("PXICLN9","VST",1,0,"AFTER"),"^",22)=PXIHLOC
  1.  .. ;
  1.  .. ;Copy v-files pointing to visit
  1.  .. ; (do not care about the stop code visit will just delete them)
  1.  .. F PXIFILE="CPT","IMM","PED","POV","PRV","SK","TRT","HF","XAM" D
  1.  ... S PXIVFILE="^AUPNV"_PXIFILE
  1.  ... S PXIVIEN=0
  1.  ... F PXICNT=1:1 S PXIVIEN=$O(@PXIVFILE@("AD",PXIVSIT,PXIVIEN)) Q:'PXIVIEN  D
  1.  .... ;
  1.  .... ;If this is Lab and is a even numbered duplicate CPT then do not save it
  1.  .... I PXIFILE="CPT",PXIPKG(2)=PXIPKG D  Q:PXITDUP=1
  1.  ..... ;check set
  1.  ..... S PXITDUP=0
  1.  ..... S PXITCNT=""
  1.  ..... F  S PXITCNT=$O(^TMP("PXICLN9","CPT",PXITCNT)) Q:'PXITCNT  D  Q:PXITDUP
  1.  ...... S PXITNODE=""
  1.  ...... F  S PXITNODE=$O(^TMP("PXICLN9","CPT",PXITCNT,PXITNODE)) Q:PXITNODE'=+PXITNODE  D  Q:PXITDUP=-1
  1.  ....... I $P(^TMP("PXICLN9","CPT",PXITCNT,PXITNODE,"AFTER"),"^",1,15)=$P($G(^AUPNVCPT(PXIVIEN,PXITNODE)),"^",1,15) S PXITDUP=1
  1.  ....... E  S PXITDUP=-1
  1.  ..... I PXITDUP=1 D
  1.  ...... S PXDUPCPT(PXITCNT)=$G(PXDUPCPT(PXITCNT))+1
  1.  ...... I '(PXDUPCPT(PXITCNT)#2) S $P(^TMP("PXICLN9","CPT",PXITCNT,0,"AFTER"),"^",16)=$P(^TMP("PXICLN9","CPT",PXITCNT,0,"AFTER"),"^",16)+$P($G(^AUPNVCPT(PXIVIEN,0)),"^",16)
  1.  .... ;
  1.  .... ;Copy a v-file entry
  1.  .... S PXINODE=""
  1.  .... F  S PXINODE=$O(@PXIVFILE@(PXIVIEN,PXINODE)) Q:PXINODE=""  D:PXINODE'=801
  1.  ..... S ^TMP("PXICLN9",PXIFILE,PXICNT,PXINODE,"AFTER")=@PXIVFILE@(PXIVIEN,PXINODE)
  1.  ..... S ^TMP("PXICLN9",PXIFILE,PXICNT,PXINODE,"BEFORE")=""
  1.  .... S ^TMP("PXICLN9",PXIFILE,PXICNT,"IEN")=""
  1.  .... ;
  1.  .... ;Now fix any fields
  1.  .... S:$P($G(^TMP("PXICLN9",PXIFILE,PXICNT,812,"AFTER")),"^",3)="" $P(^TMP("PXICLN9",PXIFILE,PXICNT,812,"AFTER"),"^",3)=PXISOR
  1.  .. ;
  1.  .. ;Process
  1.  .. ;
  1.  .. ;delete old data
  1.  .. S PXIDEL=$$DELVFILE^PXAPIDEL("ALL",PXIVSIT,"","","","","")
  1.  .. ;
  1.  .. ;save data
  1.  .. K ^TMP("PXK",$J)
  1.  .. M ^TMP("PXK",$J)=^TMP("PXICLN9")
  1.  .. K ^TMP("PXICLN9")
  1.  .. D EN1^PXKMAIN
  1.  .. S PXINVSIT=^TMP("PXK",$J,"VST",1,"IEN")
  1.  .. ;fix 801 nodes? no they are ok
  1.  .. D EVENT^PXKMAIN
  1.  .. ;
  1.  .. ;if the new visit is the same visit as the old visit then done
  1.  .. Q:PXIVSIT=PXINVSIT
  1.  .. ;
  1.  .. ;if there is a new visit then assume all worked
  1.  .. I PXINVSIT>0 D
  1.  ... ;
  1.  ... ;fix pointers from Rad and IB
  1.  ... N PXIRA,PXIIBT,PXIFDA,PXIDIERR
  1.  ... S (PXIRA(1),PXIIBT)=0
  1.  ... F  S PXIRA(1)=$O(^RADPT("AVSIT",PXIVSIT,PXIRA(1))) Q:'PXIRA(1)  D
  1.  .... S PXIRA(2)=0
  1.  .... F  S PXIRA(2)=$O(^RADPT("AVSIT",PXIVSIT,PXIRA(1),PXIRA(2))) Q:'PXIRA(2)  D
  1.  ..... S PXIRA(3)=0
  1.  ..... F  S PXIRA(3)=$O(^RADPT("AVSIT",PXIVSIT,PXIRA(1),PXIRA(2),PXIRA(3))) Q:'PXIRA(3)  D
  1.  ...... I PXIRA(1)>0,PXIRA(2)>0,PXIRA(3)>0 D
  1.  ....... S PXIRA=PXIRA(3)_","_PXIRA(2)_","_PXIRA(1)_","
  1.  ....... S PXIFDA(70.03,PXIRA,27)=PXINVSIT
  1.  ... F  S PXIIBT=$O(^IBT(356,"AVSIT",PXIVSIT,PXIIBT)) Q:'PXIIBT  D
  1.  .... I PXIIBT>0 D
  1.  ..... S PXIIBT=PXIIBT_","
  1.  ..... S PXIFDA(356,PXIIBT,.03)=PXINVSIT
  1.  ... I $D(PXIFDA) D FILE^DIE("","PXIFDA","PXIDIERR")
  1.  .. ;
  1.  .. ;if the visit was not deleted try again
  1.  .. I PXIDEL<1 D
  1.  ... ;make sure that there are no extra Outpatient Encounter entries
  1.  ... S PXIOE=0
  1.  ... F  S PXIOE=$O(^SCE("AVSIT",PXIVSIT,PXIOE)) Q:'PXIOE  D EN^SDCODEL(PXIOE,0)
  1.  ... S PXIDEL=$$KILL^VSITKIL(PXIVSIT)
  1.  ... I PXIDEL>0 D
  1.  .... ;change it to a stop visit
  1.  .... K VSIT
  1.  .... S VSIT("PRI")="S"
  1.  .... S VSIT("IEN")=PXIVSIT
  1.  .... D UPD^VSIT
  1.  .... ;there was some problem deleting this one save it
  1.  .... S ^XTMP("PXICLN9",$J,PXIVST)=PXIDEL
  1.  . ;
  1.  . ;Check the encounter type
  1.  . I $P($G(^AUPNVSIT(PXIVSIT,150)),"^",3)="O" D
  1.  .. Q:$D(^VSIT(150.1,"B",+$P($G(^DIC(40.7,+$P($G(^AUPNVSIT(PXIVSIT,0)),"^",8),0)),"^",2)))
  1.  .. ;If it is "O" and it should not be, change it to "P"
  1.  .. K VSIT
  1.  .. I $P($G(^AUPNVSIT(PXIVSIT,812)),"^",3)="" D
  1.  ... I PXICPT,$P($G(^AUPNVCPT(PXICPT,812)),"^",3)]"" S VSIT("SOR")=$P($G(^AUPNVCPT(PXICPT,812)),"^",3)
  1.  ... E  I PXIPRV,$P($G(^AUPNVPRV(PXIPRV,812)),"^",3)]"" S VSIT("SOR")=$P($G(^AUPNVPRV(PXIPRV,812)),"^",3)
  1.  .. S VSIT("PRI")="P"
  1.  .. S VSIT("SVC")="A"
  1.  .. I +$$IP^VSITCK1(+$G(^AUPNVSIT(PXIVSIT,0)),$P($G(^AUPNVSIT(PXIVSIT,0)),"^",5)) S VSIT("SVC")="I"
  1.  .. S VSIT("IEN")=PXIVSIT
  1.  .. D UPD^VSIT
  1.  . ;
  1.  . E  I $P($G(^AUPNVSIT(PXIVSIT,150)),"^",3)="P" D
  1.  .. Q:'$D(^VSIT(150.1,"B",+$P($G(^DIC(40.7,+$P($G(^AUPNVSIT(PXIVSIT,0)),"^",8),0)),"^",2)))
  1.  .. ;If it is "P" and it should not be, change it to "O"
  1.  .. K VSIT
  1.  .. I $P($G(^AUPNVSIT(PXIVSIT,812)),"^",3)="" D
  1.  ... I PXICPT,$P($G(^AUPNVCPT(PXICPT,812)),"^",3)]"" S VSIT("SOR")=$P($G(^AUPNVCPT(PXICPT,812)),"^",3)
  1.  ... E  I PXIPRV,$P($G(^AUPNVPRV(PXIPRV,812)),"^",3)]"" S VSIT("SOR")=$P($G(^AUPNVPRV(PXIPRV,812)),"^",3)
  1.  .. S VSIT("PRI")="O"
  1.  .. S VSIT("SVC")="X"
  1.  .. I +$$IP^VSITCK1(+$G(^AUPNVSIT(PXIVSIT,0)),$P($G(^AUPNVSIT(PXIVSIT,0)),"^",5)) S VSIT("SVC")="D"
  1.  .. S VSIT("IEN")=PXIVSIT
  1.  .. D UPD^VSIT
  1.  . S $P(^PX(815,1,"PATCH"),"^",1)=PXIVSIT
  1.  K ^TMP("PXICLN9"),^TMP("PXK",$J)
  1.  Q
  1.  ;
  1. RADNUC ;CAH/HIRMFO;for PCE data clean-up ;10/7/96  09:42
  1.  ;
  1. RADLOC(DFN,PXRADT) ;Returns Hosp Loc of Rad/Nuc Med exam
  1.  ;Input:
  1.  ;  DFN = Patient file #2 internal entry number
  1.  ;  PXRADT = Rad exam dt/time in internal FileMan format
  1.  ;  Sample input:  (6552,2961015.0915)
  1.  ;Output:
  1.  ;  If successful -
  1.  ;       Imaging Loc name ^ pointer to file 44
  1.  ;       Sample output:  X-RAY AREA B^35
  1.  ;
  1.  ;  If unsuccessful (exam or Imaging loc missing, or file 44
  1.  ;       entry deleted, or patient does not exist in Rad/NM Patient
  1.  ;       file #70) - 0
  1.  ;
  1.  N X,PXRA0,PXRADTI,PXRALOC,PXRALOC1,PXRALOC2
  1.  I 'DFN Q 0
  1.  I 'PXRADT Q 0
  1.  I '$D(^RADPT(DFN)) Q 0  ;patient doesn't exist in file #70
  1.  S PXRADTI=9999999.9999-PXRADT ;Convert exam dt/t to subfile ien
  1.  S PXRA0=$G(^RADPT(DFN,"DT",PXRADTI,0)) I '$L(PXRA0) Q 0  ;if no such rad/nuc med visit, fail
  1.  S PXRALOC=$P(PXRA0,"^",4) I 'PXRALOC Q 0  ;if no imaging loc, fail
  1.  S PXRALOC1=$P(^RA(79.1,+PXRALOC,0),"^",1) I 'PXRALOC1 Q 0  ;if dangling pointer - file 44 entry deleted? fail
  1.  I '$D(^SC(PXRALOC1)) Q 0  ;File 44 entry deleted?  fail
  1.  S PXRALOC2=$P($G(^SC(PXRALOC1,0)),"^",1)
  1.  Q PXRALOC2_"^"_PXRALOC1
  1.  ;