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

SD53103A.m

Go to the documentation of this file. 
  1. SD53103A ;ALB/MJK - Unique Visit ID Clean Up ; March 10,1997
  1.  ;;5.3;Scheduling;**103,748,766**;AUG 13, 1993;Build 3
  1.  ;
  1.  Q
  1.  ;
  1.  ; Reference to ^TIU(8925,"V" supported by ICR #7142
  1.  ; Reference to ^TIU(8925, supported by ICR #7142
  1.  ;
  1. EN ;Unique Visit ID Clean Up Option entry point
  1.  N DIR,Y,X,DIRUT
  1.  S DIR(0)="SO^1:One Entry;A:All Entries"
  1.  S DIR("A")="Enter '1' for a single entry or 'A' for All entries"
  1.  S DIR("?")="Enter '1' for a single entry or 'A' for all entries."
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  I Y=1 D ONE
  1.  I Y="A" D SCAN
  1.  Q
  1. ONE ; -- entry point to select a single -1 encounter and resync
  1.  N DIC,Y,SDOE,SDPKG,SDTALK,SDEXIT,SDVST,SDTIU,SDTIU1
  1.  IF '$$INIT^SD53103B() G ONEQ
  1.  S SDTALK=1,SDEXIT=0
  1.  D HDR^SD53103B("Single") W !
  1.  F  D  IF SDEXIT G ONEQ
  1.  . S DIC="^SCE(",DIC("S")="N SDOE0 S SDOE0=^(0) IF $$SCREEN^SD53103A(SDOE0)",DIC(0)="AEMQ" D ^DIC
  1.  . IF +Y<1 S SDEXIT=1 Q
  1.  . ; -- display record
  1.  . S SDOE=+Y D OE^SD53103B(SDOE)
  1.  . S SDVST=$$VSIT(SDOE),SDTIU=$O(^TIU(8925,"V",SDVST,0)) ;SD*5.3*748 - Set TIU info
  1.  . IF $$OK^SD53103B() D
  1.  . . N SDX
  1.  . . S SDX=$$MSG(SDOE,$$RESYNC(SDOE))
  1.  . . IF $P(SDX,U)["RE-LINKED" D
  1.  . . . W "Re-Linked successfully:"
  1.  . . . D OE^SD53103B(SDOE)
  1.  . . . S SDTIU1=0 F  S SDTIU1=$O(^TIU(8925,"V",SDVST,SDTIU1)) Q:SDTIU1=""  D TIU^SD53103B(SDTIU1) ;SD*5.3*766 - Write TIU info for all linked notes
  1.  . . IF $P(SDX,U)'["RE-LINKED"  D  ;SD*5.3*748 - change else
  1.  . . . W $C(7),"Error has occurred.",!,"Please make a note of the following: ",!?10,SDX,!
  1. ONEQ Q
  1.  ;
  1. SCAN ; -- entry point to scan encounter file for -1's to either
  1.  ;    'count only' or 'count and fix'
  1.  N SDBEG,SDEND,SDMODE,SDPKG,SDTALK
  1.  ;
  1.  ; -- init global locals
  1.  IF '$$INIT^SD53103B() G SCANQ
  1.  D HDR^SD53103B("Date Range")
  1.  ;
  1.  ; -- get date range
  1.  IF '$$RANGE^SD53103B(.SDBEG,.SDEND) G SCANQ
  1.  ;
  1.  ; -- ask which mode
  1.  S SDMODE=$$MODE^SD53103B() IF 'SDMODE G SCANQ
  1.  ;
  1.  ; -- ask if ok to continue
  1.  IF '$$OK^SD53103B() G SCANQ
  1.  ; -- queue process
  1.  D QUEUE
  1. SCANQ Q
  1.  ;
  1. QUEUE ; queue job
  1.  N I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  W !
  1.  S ZTIO="",ZTDESC="Fix -1 Outpatient Encounters",ZTRTN="DQ^SD53103A"
  1.  F I="SDTALK","SDMODE","SDBEG","SDEND","SDPKG" S ZTSAVE(I)=""
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK) W !!,"Task queued:  #",ZTSK
  1.  Q
  1.  ;
  1.  ;
  1. DQ ; -- dequeue point...collect results and generate message.
  1.  N SDOE,SDOE0,SDDT,SDCNT,SDRT
  1.  ; -- set up and scan records
  1.  S SDDT=SDBEG,SDCNT=0,SDRT=$NA(^TMP("SDVISIT FIX",$J)) K @SDRT
  1.  F  S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDEND)  D  Q:$$S^%ZTLOAD
  1.  . S SDOE=""
  1.  . F  S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE  D
  1.  . . S SDOE0=$G(^SCE(SDOE,0)) Q:SDOE0=""
  1.  . . ; -- use only -1's
  1.  . . IF $$SCREEN(.SDOE0) D
  1.  . . . S SDCNT=SDCNT+1
  1.  . . . IF SDMODE=1 S @SDRT@(SDCNT)=$$MSG(SDOE,"COUNT ONLY")
  1.  . . . IF SDMODE=2 S @SDRT@(SDCNT)=$$MSG(SDOE,$$RESYNC(SDOE))
  1.  ;
  1.  D RESULTS^SD53103B(.SDMODE,.SDBEG,.SDEND,.SDRT,.SDCNT)
  1.  K @SDRT
  1.  Q
  1.  ;
  1. SCREEN(SDOE0) ; -- process screen for -1's and null ID's
  1.  N SDOK
  1.  ; -- don't use if before 10/1/96
  1.  IF +SDOE0,+SDOE0<2961001 Q 0
  1.  ; -- use if -1 id
  1.  IF $P(SDOE0,U,20)=-1 Q 1
  1.  ; -- use if id null and (has a completion date OR action req status)
  1.  IF $P(SDOE0,U,20)="",$P(SDOE0,U,7)!($P(SDOE0,U,12)=14) Q 1
  1.  ; -- use if id nul and visit exists
  1.  IF $P(SDOE0,U,20)="",$P(SDOE0,U,5) Q 1
  1.  Q 0
  1.  ;
  1. MSG(SDOE,STATUS) ; -- build display text
  1.  N SDOE0,SDMSG,SDVT,SDTI,SDTIU
  1.  S SDOE0=$G(^SCE(+$G(SDOE),0))
  1.  IF SDOE0="" S SDMSG="Bad encounter entry passed"_U_+$G(SDOE)_U G MSGQ
  1.  S SDMSG=$S(STATUS["ERROR":">> ",1:"   ")_STATUS
  1.  S SDMSG=SDMSG_U_SDOE_U_$P(SDOE0,U,6)_U_$P(SDOE0,U,5)
  1.  S SDMSG=SDMSG_U_$P($G(^DPT(+$P(SDOE0,U,2),0),"Unknown Patient"),U)
  1.  S SDMSG=SDMSG_U_$$FMTE^XLFDT(+SDOE0)
  1.  S SDMSG=SDMSG_U_$P($G(^SC(+$P(SDOE0,U,4),0),"Unknown Clinic"),U)
  1.  S SDVT=$P(SDOE0,U,5) I SDVT S SDTI=0,SDTIU="" F  S SDTI=$O(^TIU(8925,"V",SDVT,SDTI)) Q:'SDTI  S SDTIU=SDTIU_SDTI_", " ;SD*5.3*766 - Include All TIU Documents
  1.  S:$G(SDTIU)'="" SDMSG=SDMSG_U_$P(SDTIU,",",1,($L(SDTIU,",")-1)) ;SD*5.3*766 - Include TIU Documents in mailman message
  1. MSGQ Q SDMSG
  1.  ;
  1. RESYNC(SDOE) ; -- resync sd and pce data
  1.  N SDOE0,SDVST,SDOK,SDOEC,SDCNT
  1.  S SDOK=0
  1.  S SDOE0=$G(^SCE(SDOE,0))
  1.  IF SDOE0="" G RESYNCQ
  1.  ;
  1.  ; -- get visit
  1.  S SDVST=$$VSIT(SDOE)
  1.  IF 'SDVST G RESYNCQ
  1.  D DOT
  1.  ;
  1.  ; -- set oe visit field
  1.  D OESET(SDOE,SDVST)
  1.  D TIUPD(SDVST)
  1.  ;
  1.  ; -- quit if child
  1.  IF $P(SDOE0,U,6) D  G RESYNCQ
  1.  . S SDOK=1
  1.  ; -- set oe visit field for children of parent
  1.  ;SD*5.3*766 - Remove code that updates Child Visits
  1.  ;S SDOEC=0
  1.  ;F  S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC  D OESET(SDOEC,SDVST),TIUPD(SDVST)
  1.  ;
  1.  ; -- send data to pce for parent
  1.  S SDOK=$$DATA2PCE(SDOE)
  1.  ;
  1. RESYNCQ Q $S(SDOK:"RE-LINKED",1:"ERROR OCCURRED")
  1.  ;
  1. OESET(SDOE,SDVST) ; -- set oe visit field
  1.  N DA,DR,DIE
  1.  ;
  1.  ; -- if id = -1 reset id
  1.  IF $P($G(^AUPNVSIT(+SDVST,150)),U)="-1"!($P($G(^AUPNVSIT(+SDVST,150)),U)="") D  ;SD*5.3*766 - include null values
  1.  . N ID
  1.  . S ID=$$GETVID^VSITVID()
  1.  . K ^AUPNVSIT("VID",-1,+SDVST)
  1.  . S $P(^AUPNVSIT(+SDVST,150),U)=ID
  1.  . S ^AUPNVSIT("VID",ID,+SDVST)=""
  1.  ;
  1.  S DIE="^SCE(",DR=".05////"_SDVST,DA=SDOE D ^DIE
  1.  D DOT
  1.  Q
  1.  ;
  1. VSIT(SDOE) ; -- get/find visit
  1.  N SDOE0,SDVST,VSIT,DFN,DIE,DIC,DR,DA,X,VSITPKG,SDOEP
  1.  S SDVST=0
  1.  S SDOE0=$G(^SCE(+$G(SDOE),0))
  1.  IF SDOE0="" G VSITQ
  1.  ;
  1.  ; -- if entry already has visit, use it
  1.  IF $P(SDOE0,U,5) S SDVST=$P(SDOE0,U,5) G VSITQ
  1.  ;
  1.  ; -- if parent has pointer to visit, use it
  1.  ;Remove Parent Check; use Unique ID tied to Visit
  1.  ;S SDOEP=$P(SDOE0,U,6)
  1.  ;IF SDOEP D  IF SDVST G VSITQ
  1.  ;. S SDVST=$P($G(^SCE(SDOEP,0)),U,5)
  1.  ;
  1.  ; -- call api to get visit entry
  1.  S VSIT(0)="ENMD1"
  1.  S VSIT=+SDOE0
  1.  S DFN=+$P(SDOE0,U,2)
  1.  S VSITPKG="SD"
  1.  S VSIT("CLN")=$P(SDOE0,U,3)
  1.  S VSIT("SVC")=$S($$INP^SDAM2(DFN,VSIT)="I":"I",1:"A")
  1.  S VSIT("INS")=$P($G(^DG(40.8,+$P(SDOE0,U,11),0)),U,7)
  1.  S VSIT("ELG")=$S($P(SDOE0,U,13):$P(SDOE0,U,13),1:+$G(^DPT(DFN,.36)))
  1.  IF $P(SDOE0,U,4) S VSIT("LOC")=$P(SDOE0,U,4)
  1.  IF $P(SDOE0,U,6) S X=$G(^SCE($P(SDOE0,U,6),0)) IF X]"" S VSIT=+X I $P(X,U,5) S VSIT("LNK")=$P(X,U,5)
  1.  IF '$P(SDOE0,U,6) D
  1.  . S VSIT("PRI")="P"
  1.  E  D
  1.  . IF $P(SDOE0,U,8)=4 D
  1.  . . S VSIT("PRI")="C",VSIT("SVC")=$S($$INP^SDAM2(DFN,VSIT)="I":"D",1:"X")
  1.  . E  D
  1.  . . S VSIT("PRI")="S"
  1.  ;
  1.  ; -- do checks
  1.  I 'VSIT,'DFN,'VSIT("ELG")!('VSIT("INS"))!('VSIT("CLN")) G VSITQ
  1.  ;
  1.  ; -- add/find visit
  1.  ;
  1.  ; -- change call if orinating process is a disposition.
  1.  I $P(SDOE0,U,8)=3 D
  1.  .; -- must be valid disposition clinic
  1.  . IF $O(^PX(815,1,"DHL","B",+$P(SDOE0,U,4),0)) D DISPVSIT^PXAPI Q
  1.  .; -- if interactive mode, ok to get visit
  1.  . IF SDTALK D
  1.  . . D DISPVSIT^PXAPI
  1.  . .; -- visit created and loc defined; re-set oe location field
  1.  . . IF +$G(VSIT("IEN"))>0,VSIT("LOC") D
  1.  . . . S $P(^SCE(SDOE,0),U,4)=VSIT("LOC")
  1.  . . .; -- re-set children oe location field
  1.  . . .; SD*5.3*766 - Remove code that updates Child Visits
  1.  . . .;N SDOEC S SDOEC=0
  1.  . . .;F  S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC  D
  1.  . . .; S $P(^SCE(SDOEC,0),U,4)=VSIT("LOC")
  1.  ;
  1.  IF $P(SDOE0,U,8)'=3 D
  1.  .; -- quit if parent is a disposition and bad location; parent will fix
  1.  . IF $P($G(^SCE(+$P(SDOE0,U,6),0)),U,8)=3,'$O(^PX(815,1,"DHL","B",+$P(SDOE0,U,4),0)) Q
  1.  . D ^VSIT
  1.  ;
  1.  IF +$G(VSIT("IEN"))>0 S SDVST=+VSIT("IEN")
  1. VSITQ Q SDVST
  1.  ;
  1. DATA2PCE(SDOE) ; -- send data to pce
  1.  N SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SDPCE,SDOK,SDOEC
  1.  S SDOK=0
  1.  ;
  1.  ; -- gather needed data
  1.  S SDOE0=$G(^SCE(SDOE,0)) G DATAQ:SDOE0=""
  1.  S SDVST=$P(SDOE0,U,5) G DATAQ:'SDVST
  1.  ;
  1.  ; -- if visit has v-file data quit
  1.  IF $O(^AUPNVCPT("AD",SDVST,0))!($O(^AUPNVPRV("AD",SDVST,0)))!($O(^AUPNVPOV("AD",SDVST,0))) S SDOK=1 G DATAQ
  1.  ;
  1.  ; -- get data from parent
  1.  D SET(SDOE,"SDPRV",409.44),DOT
  1.  D SET(SDOE,"SDIAG",409.43),DOT
  1.  D SET(SDOE,"SDCLS",409.42),DOT
  1.  D PROC^SCDXUTL0(SDOE,"SDPROC"),DOT ; -- gets both parent & children data
  1.  ;
  1.  ; -- get data from children
  1.  S SDOEC=0
  1.  F  S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC  D
  1.  . D SET(SDOEC,"SDPRV",409.44),DOT
  1.  . D SET(SDOEC,"SDIAG",409.43),DOT
  1.  . D SET(SDOEC,"SDCLS",409.42),DOT
  1.  ;
  1.  ; ---build pce data array
  1.  D BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SDPCE")
  1.  ;
  1.  ; -- call pce api to file data
  1.  IF $$DATA2PCE^PXAPI("SDPCE",SDPKG,"SD TO PCE RESYNC",SDVST)=1 D
  1.  . S SDOK=1
  1. DATAQ Q SDOK
  1.  ;
  1. BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA) ; -- build pce data array
  1.  N X,SDI,SDIEN,SDCNT
  1.  S SDI=0 F  S SDI=$O(@SDCLASS@(SDI)) Q:'SDI  D
  1.  . S X=@SDCLASS@(SDI)
  1.  . S @SDATA@("ENCOUNTER",1,$P("AO^IR^SC^EC",U,+X))=$P(X,U,3)
  1.  ;
  1.  ; -- set provider info
  1.  IF $O(@SDPROV@(0)) D
  1.  . S (SDCNT,SDIEN)=0
  1.  . F  S SDIEN=$O(@SDPROV@(SDIEN)) Q:'SDIEN  D
  1.  . . S X=@SDPROV@(SDIEN)
  1.  . . S SDCNT=SDCNT+1
  1.  . . S @SDATA@("PROVIDER",SDCNT,"NAME")=+X
  1.  ;
  1.  ; -- set dx info
  1.  IF $O(@SDDX@(0)) D
  1.  . S (SDCNT,SDIEN)=0
  1.  . F  S SDIEN=$O(@SDDX@(SDIEN)) Q:'SDIEN  D
  1.  . . S X=@SDDX@(SDIEN)
  1.  . . S SDCNT=SDCNT+1
  1.  . . S @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
  1.  . . S @SDATA@("DX/PL",SDCNT,"PRIMARY")=+$P(X,U,3)
  1.  ;
  1.  ; -- set cpt info
  1.  IF $O(@SDCPT@(0)) D
  1.  . ; -- count times performed
  1.  . N SDX
  1.  . S (SDCNT,SDIEN)=0
  1.  . F  S SDIEN=$O(@SDCPT@(SDIEN)) Q:'SDIEN  D
  1.  . . S X=@SDCPT@(SDIEN)
  1.  . . S SDX(+X)=$G(SDX(+X))+1
  1.  . ;
  1.  . ; -- build nodes
  1.  . S (SDCNT,SDIEN)=0
  1.  . F  S SDIEN=$O(SDX(SDIEN)) Q:'SDIEN  D
  1.  . . S X=SDX(SDIEN)
  1.  . . S SDCNT=SDCNT+1
  1.  . . S @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
  1.  . . S @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
  1. BUILDQ Q
  1.  ;
  1. SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
  1.  ; Input  -- SDOE      Outpatient Encounter IEN
  1.  ; Output -- ARRAY     Provider or dx Array Subscripted by a ien
  1.  ;
  1.  N SDIEN
  1.  S SDIEN=0
  1.  F  S SDIEN=$O(^SDD(FILE,"OE",SDOE,SDIEN)) Q:'SDIEN  D
  1.  . S X=$G(^SDD(FILE,SDIEN,0)) Q:X=""
  1.  . S @ARRAY@(SDIEN)=X
  1. SETQ Q
  1.  ;
  1. DOT ; -- write '.' if ok to talk
  1.  IF SDTALK D
  1.  . W "."
  1.  Q
  1.  ;
  1. TIUPD(SDVST) ;Correct TIU document if applicable, SD*5.3*748
  1.  N DA,DIK
  1.  S DA=0 F  S DA=$O(^TIU(8925,"V",SDVST,DA)) Q:'DA  S DIK="^TIU(8925,",DIK(1)=".03^7" D EN1^DIK ;SD*5.3*766 - Loop to get all entries tied to Visit
  1.  Q