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

SCENIA2.m

Go to the documentation of this file. 
  1. SCENIA2 ;ALB/SCK - INCOMPLETE ENCOUNTER ERROR DISPLAY PROTOCOLS, CONT. ; OCT 21, 1998
  1.  ;;5.3;PIMS;**66,132,158,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1. EVT1(SDXMT,INF) ; Returns ifn for ^SC(clinic,"S",date,1,ifn)
  1.  N SINDX,SDDA
  1.  ;
  1.  S SINDX=0 F  S SINDX=$O(^SC(INF("CLINIC"),"S",INF("ENCOUNTER"),1,SINDX))  Q:'SINDX>0  D  Q:$D(SDDA)
  1.  . I +^SC(INF("CLINIC"),"S",INF("ENCOUNTER"),1,SINDX,0)=INF("DFN") S SDDA=SINDX
  1.  Q $G(SDDA)
  1.  ;
  1. EI ; Entry point for the SCENI ENCOUNTER INFORMATION protocol
  1.  I '$D(SD53P158) N SD53P158 S SD53P158="LM" ; Called via LM.
  1.  I '$D(^XUSEC("SCENI ENCOUNTER EDIT",DUZ)) D  Q
  1.  . W !,$C(7),"You do not have this security key, contact your supervisor."
  1.  ;
  1.  N SDATA,SCEN,SDXMT,SCXER,SDOE,SCINF,SCSTAT,SDEVT,SDHDL,SDDA,SCELAP,SCSTPLC,OLDSC,SDQUIT,SDLOG
  1.  N SDFLAG,SDVST S SDFLAG=0,SDVST=""  ;SD*560
  1.  ;
  1.  K PARENT,VISIT
  1.  D HDLKILL^SDAMEVT
  1.  S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
  1.  S SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
  1.  I SCSTAT<0 D  G EIQ
  1.  . W !!,$C(7),"Entry "_$P(^SD(409.73,SDXMT,0),U),?5,$G(SCINF("ERROR"))
  1.  . D PAUSE^VALM1
  1.  ;
  1.  I SCSTAT>0 D  G EIQ
  1.  . W !!,$C(7),"This is a deleted entry.  Encounter information cannot be changed."
  1.  . D PAUSE^VALM1
  1.  ;
  1.  S DFN=SCINF("DFN")
  1.  S SDOE=$P(^SD(409.73,SDXMT,0),U,2)
  1.  S SDHDL=$$HANDLE^SDAMEVT($P($G(^SCE(SDOE,0)),U,8)),SDDA=$$EVT1(SDXMT,.SCINF)
  1.  Q:SDHDL']""
  1.  ;
  1.  S:'SDDA SDFLAG=1  ;SD*5.3*560 encounter not associated w/sched appt
  1.  S SDATA=SDDA_"^"_DFN_"^"_SCINF("ENCOUNTER")_"^"_SCINF("CLINIC")
  1.  S SDQUIT=0
  1.  ;
  1.  L +^SCE(SDOE):0 I '$T D  G EIQ
  1.  . W !?5,$CHAR(7),"Another user is editing this entry"
  1.  I SD53P158="LM" D FULL^VALM1
  1.  K DIRUT
  1.  W !
  1.  D BEFORE^SDAMEVT(.SDATA,DFN,SCINF("ENCOUNTER"),SCINF("CLINIC"),SDDA,SDHDL)
  1.  ;
  1.  K OLDSC,SDEDT S OLDSC=+$P($G(^SCE(SDOE,0)),U,3),SDEDT=$P(^(0),U,1)
  1. EI1 S DIR(0)="409.68,.03",DA=SDOE
  1.  D ^DIR K DIR G:$D(DIRUT)!(Y="") EIQ
  1.  ;SD*560 do not allow if Inactive at time of encounter
  1.  I $P(^DIC(40.7,+Y,0),U,3)'="" I $P(^(0),U,3)'>SDEDT D  G EI1
  1.  .W !!,"Sorry, that Stop Code was INACTIVE at the time of the selected encounter.",!
  1.  ;SD*560 do not allow if Restriction Type is "S"
  1.  I $P(^DIC(40.7,+Y,0),U,6)="S" I $P(^(0),U,7)'>SDEDT D  G EI1
  1.  .W !!,"Sorry, the Restriction Type for that Stop Code is 'S' (secondary only).",!,"You cannot select this stop code.",!
  1.  S $P(SCSTPLC,U)=+Y
  1.  D SET(+Y,.03,SDOE)
  1.  I SDFLAG I OLDSC'=+Y D SET1(+Y,SDOE,1)  ;SD*560 set Visit & Trans flag
  1.  ;
  1.  K OLDDV S OLDDV=+$P($G(^SCE(SDOE,0)),U,11)  ;SD*560 get current Division
  1.  S DIR(0)="409.68,.11",DA=SDOE
  1.  D ^DIR K DIR G:$D(DIRUT)!(Y="") A1
  1.  S $P(SCSTPLC,U,2)=+Y
  1.  D SET(+Y,.11,SDOE)
  1.  I OLDDV'=+Y D SETDV(+Y,SDOE)  ;SD*560 set Visit & Trans flag
  1.  K OLDDV
  1.  ;
  1.  ; ** Display current Appt. Type and Elig. Codes
  1.  N SD1,OLDAT S (SD1,OLDAT)=$P($G(^SCE(SDOE,0)),U,10)  ;SD*560 add OLDAT
  1.  W !!!,$C(7),"Current Appointment Type for Encounter: "_$S($G(SD1):$P(^SD(409.1,SD1,0),U),1:"")
  1.  K SD1,OLDELG S (SD1,OLDELG)=$P($G(^SCE(SDOE,0)),U,13)  ;sD*560 add OLDELG
  1.  W !,"Current Eligibility for Encounter: "_$S($G(SD1):$P(^DIC(8,SD1,0),U),1:""),!
  1.  ;
  1.  S DIR(0)="YA",DIR("B")="NO",DIR("A")="Change Eligibility/Appointment type? " D ^DIR K DIR G:$D(DIRUT)!(Y=0) A1
  1.  ;
  1.  ;SD*560 if SC Indicator in Visit equals 1 (Service Connected) do not allow edit of Appt Type or Eligibility
  1.  I $P(^SCE(SDOE,0),U,10)'=10 S SDVST=$P(^SCE(SDOE,0),U,5) I $D(^AUPNVSIT(SDVST,800)) I +$G(^(800))=1 D  G A1
  1.  .W !!,"The Visit associated with the selected encounter is SERVICE CONNECTED."
  1.  .W !,"You cannot edit the Appointment Type or Eligibility for this encounter.",!
  1.  ;
  1.  W !,"The following are system defaults only.",!
  1.  ;
  1.  S SCELAP=$$ELAP^SDPCE(DFN,SCINF("CLINIC"))
  1.  ;
  1.  N SDPRIM
  1.  S SDPRIM=$$ONEELIG
  1.  ;if only a primary ask if they want to change to it and change
  1.  I SDPRIM,+SDPRIM'=SD1 DO
  1.  .N DIR
  1.  .S DIR(0)="YA",DIR("B")="YES"
  1.  .S DIR("A",1)="There is only a primary eligibility for this patient: "_$P(SDPRIM,U,2)
  1.  .S DIR("A")="Do you wish to change the encounter to this? "
  1.  .S DIR("?")="No other Eligibilities are selectable."
  1.  .S DIR("?",1)="YES will result in the current primary Eligibility being used for the encounter."
  1.  .S DIR("?",2)="NO will result in the encounter's Eligibility being left the same."
  1.  .D ^DIR
  1.  .I Y=1 S $P(SCELAP,U,1)=+SDPRIM,$P(SCELAP,U,2)=$P(SDPRIM,U,2)
  1.  .E  S $P(SCELAP,U,1)=SD1,$P(SCELAP,U,2)=$P($G(^DIC(8,+SD1,0)),U,1)
  1.  .Q
  1.  ;
  1.  D SET(+SCELAP,.13,SDOE)
  1.  ;SD*560 if Elig edited on non-appt encounter, update Visit & Trans flag
  1.  I SDFLAG I OLDELG'=+SCELAP D SET1(+SCELAP,SDOE,2)
  1.  D SET(+$P(SCELAP,U,3),.1,SDOE)
  1.  ;
  1. A1 D RESYNC(SCSTPLC,$G(SCELAP),SDOE,OLDSC,DFN)
  1.  D LOGDATA^SDAPIAP(SDOE,.SDLOG)
  1.  D AFTER^SDAMEVT(.SDATA,DFN,SCINF("ENCOUNTER"),SCINF("CLINIC"),SDDA,SDHDL)
  1.  ;
  1.  D EVT^SDAMEVT(.SDATA,5,0,SDHDL)
  1.  I '$D(SDOK) D  I $G(RTN)<0 G EIQ
  1.  . S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
  1.  . I RTN<0 D ERMSG^SCENIA1(5) Q
  1.  . S RTN=$$SETRFLG^SCENIA1(SDXMT)
  1.  . I RTN<0 D ERMSG^SCENIA1(3) Q
  1.  ;SD*560 if appt type edited, check if it was allowed and changed
  1.  I $D(SCELAP) I OLDAT'=+$P(SCELAP,U,3) S POP=0 D
  1.  .I OLDAT=10 I +$P(SCELAP,U,3)=11 D  Q:POP
  1.  ..I +$P(^SCE(SDOE,0),U,10)'=11 I $D(^AUPNVSIT($P(^SCE(SDOE,0),U,5),800)) I +$G(^(800),"")=0 D A1WRT,A2WRT S POP=1 Q
  1.  .I OLDAT=10 I +$P(SCELAP,U,3)'=11 D  Q:POP
  1.  ..I +$P(^SCE(SDOE,0),U,10)=11 I $D(^AUPNVSIT($P(^SCE(SDOE,0),U,5),800)) I +$G(^(800),"")=1 D A1WRT1,A2WRT S POP=1 Q
  1.  .Q:OLDAT'=$P(^SCE(SDOE,0),U,10)
  1.  .I OLDAT'=11 I $P(SCELAP,U,3)=11 D A1WRT Q
  1.  K POP
  1.  ;SD*560 if Appt Type edit accepted on non-appt encounter set encounter to retrans
  1.  I SDFLAG I $D(SCELAP) I OLDAT'=+$P(SCELAP,U,3) D
  1.  .S XMIT="",XMIT=$$FINDXMIT^SCDXFU01(SDOE)  ;get IEN for file 409.73
  1.  .D:XMIT STREEVNT^SCDXFU01(XMIT,2)  ;set trans event to edit
  1.  .D:XMIT XMITFLAG^SCDXFU01(XMIT)  ;set flag for trans to Yes
  1.  .K XMIT,OLDAT
  1.  I $D(SDOK) S SDOK=1
  1.  W !,"Updating Completed."  ;SD*560 moved from RESYNC
  1.  L -^SCE(SDOE):0
  1. EIQ K OLDSC,OLDAT,OLDELG,SDFLAG K:$D(POP) POP
  1.  Q
  1.  ;
  1. A1WRT ;SD*560 write warning message, if applicable
  1.  W !!,"The Visit entry associated with the selected encounter is NOT SERVICE CONNECTED."
  1.  W !,"You cannot change the Appointment Type to SERVICE CONNECTED.",!
  1.  Q
  1.  ;
  1. A1WRT1 ;SD*560 write warning message if Service Connected
  1.  W !!,"The Visit entry associated with the selected encounter is SERVICE CONNECTED."
  1.  W !,"You cannot change the Appointment Type to non-SERVICE CONNECTED."
  1.  Q
  1.  ;
  1. A2WRT ;SD*560 display current Appointment Type per update.
  1.  W !,"Appointment Type has been updated to ",$P(^SD(409.1,$P(^SCE(SDOE,0),U,10),0),U,1),".",!
  1.  Q
  1.  ;
  1. SET(SDVAL,SDFLD,DA) ; Set updated entry into file #409.68.
  1.  ;
  1.  S ^TMP("SCENI EDIN",$J,409.68,DA_",",SDFLD)=SDVAL
  1.  D FILE^DIE("K","^TMP(""SCENI EDIN"",$J)")
  1.  I $D(^TMP("DIERR",$J,1)) W !!,"???"
  1.  K ^TMP("SCENI EDIN",$J),^TMP("DIERR",$J)
  1.  Q
  1.  ;
  1. SET1(SDVAL,SDOE,SEDT)  ;SD*560 set Visit & Trans Flag for non-appt encounter
  1.  ;SEDT=1 primary stop code edit
  1.  ;SEDT=2 eligibility edit
  1.  N SDVST,VDT,SDCVST
  1.  S SDVST=$P(^SCE(SDOE,0),U,5) Q:'SDVST
  1.  S VDT=$$NOW^XLFDT
  1.  S DA=SDVST,DIE="^AUPNVSIT("
  1.  I SEDT=1 S DR=".08////^S X=SDVAL;.13////^S X=VDT" D ^DIE
  1.  I SEDT=2 S DR=".21////^S X=SDVAL;.13////^S X=VDT" D ^DIE
  1.  ;check for credit Visit and update, if applicable
  1.  I $O(^AUPNVSIT("AD",SDVST,"")) S SDCVST=$O(^AUPNVSIT("AD",SDVST,"")) D
  1.  .Q:SEDT=1   ;do not update if primary stop code edit
  1.  .K DA,DR
  1.  .S DA=SDCVST
  1.  .S DR=".21////^S X=SDVAL;.13////^S X=VDT" D ^DIE
  1.  S XMIT="",XMIT=$$FINDXMIT^SCDXFU01(SDOE)  ;get IEN for file 409.73
  1.  D:XMIT STREEVNT^SCDXFU01(XMIT,2)  ;set trans event to edit
  1.  D:XMIT XMITFLAG^SCDXFU01(XMIT)  ;set flag for trans required to Yes
  1.  K XMIT,DA,DR,X,DIE
  1.  Q
  1.  ;
  1. SETDV(SDVAL,SDOE)  ;SD*560 set Visit & Trans Flag when Division edited
  1.  N SDVST,VDT,SDNDV,SDCVST
  1.  S SDVST=$P(^SCE(SDOE,0),U,5) Q:'SDVST
  1.  S SDNDV=+$P($G(^DG(40.8,SDVAL,0)),U,7)  ;get pointer to Institution file
  1.  S VDT=$$NOW^XLFDT
  1.  S DA=SDVST,DIE="^AUPNVSIT("
  1.  S DR=".06////^S X=SDNDV;.13////^S X=VDT" D ^DIE
  1.  ;check for credit Visit and update, if applicable
  1.  I $O(^AUPNVSIT("AD",SDVST,"")) S SDCVST=$O(^AUPNVSIT("AD",SDVST,"")) D
  1.  .K DA,DR
  1.  .S DA=SDCVST
  1.  .S DR=".06////^S X=SDNDV;.13////^S X=VDT" D ^DIE
  1.  S XMIT="",XMIT=$$FINDXMIT^SCDXFU01(SDOE)  ;get IEN for file 409.73
  1.  D:XMIT STREEVNT^SCDXFU01(XMIT,2)  ;set trans event to edit
  1.  D:XMIT XMITFLAG^SCDXFU01(XMIT)  ;set flag for trans required to Yes
  1.  K DA,DR,DIE,SD408,XMIT
  1.  Q
  1.  ;
  1. UPDENC ;  Update Outpatient Encounter Option entry point
  1.  N SDOE,SDXMT,DFN,SDOK
  1.  N SD53P158 S SD53P158="OPT" ;Entered via menu option.
  1.  ;
  1.  S SDOK=0
  1.  K ^TMP("SCENI XMT",$J)
  1.  S DIR(0)="PA^409.68:EMQ",DIR("S")="I $D(^SD(409.73,""AENC"",Y))"
  1.  S DIR("A")="Select Encounter to update: "
  1.  S DIR("?")="Enter partial name, last four, or date of encounter."
  1.  S DIR("??")="^S %DT=""PX"" D HELP^%DTC"
  1.  D ^DIR K DIR G UPDQ:$D(DIRUT)
  1.  ;
  1.  S SDOE=+Y
  1.  S SDXMT=$O(^SD(409.73,"AENC",SDOE,0))
  1.  S ^TMP("SCENI XMT",$J,0)=SDXMT
  1.  D EI
  1. UPDQ ;
  1.  K DFN
  1.  Q
  1.  ;
  1. RESYNC(STPL,SCELP,SDOE,SCOLD,SDFN) ;
  1.  N SDOEC,SDCDT
  1.  ;
  1.  ; ** Update any child encounters and for each child encounter, search for
  1.  ;    any entries in the Scheduling Visits File, #409.5.  If there is a 
  1.  ;    match, update then entry in #409.5
  1.  ;
  1.  ;everthing else
  1.  S SDOEC=""
  1.  F  S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC  D
  1.  . I +$P($G(^SCE(SDOE,0)),U,13)>0 D SET(+$P($G(^SCE(SDOE,0)),U,13),.13,SDOEC)
  1.  . I +$P($G(^SCE(SDOE,0)),U,10)>0 D SET(+$P($G(^SCE(SDOE,0)),U,10),.1,SDOEC)
  1.  . I +$P($G(^SCE(SDOE,0)),U,11)>0 D SET(+$P($G(^SCE(SDOE,0)),U,11),.11,SDOEC)
  1.  . I "2"[+$P($G(^SCE(SDOEC,0)),U,8),($P($G(^SCE(SDOEC,0)),U,3)=SCOLD) D SET(+$P($G(^SCE(SDOE,0)),U,3),.03,SDOEC)
  1.  ;
  1.  ; ** Update the entry in the Clinic Appointment multiple for the encounter
  1.  S SDOEDT=$P($G(^SCE(SDOE,0)),U),SDCLN=$P($G(^(0)),U,4)
  1.  S SDN1=0  F  S SDN1=$O(^SC(SDCLN,"S",SDOEDT,1,SDN1)) Q:'SDN1  D
  1.  . I $P($G(^SC(SDCLN,"S",SDOEDT,1,SDN1,0)),U)=SDFN D
  1.  .. S DIE="^SC(SDCLN,""S"",SDOEDT,1,",DA(2)=SDCLN,DA(1)=SDOEDT,DA=SDN1
  1.  .. S DR="30////"_$P(SCELP,U)
  1.  .. L +^SC(SDCLN,"S",SDOEDT,1,SDN1):$S($G(DILOCKTM)>0:DILOCKTM,1:5)  ;SD*560 added required timeout
  1.  .. D ^DIE K DIE,DR,DA
  1.  .. L -^SC(SDCLN,"S",SDOEDT,1,SDN1)
  1.  ;
  1.  ; ** Update the entry in the Patient Appointment multiple for the encounter.
  1.  I $D(^DPT(SDFN,"S",SDOEDT,0)),($P(^(0),U,20)=SDOE) D
  1.  . S DIE="^DPT(SDFN,""S"",",DA(1)=SDFN,DA=SDOEDT
  1.  . S DR="9.5////"_$P(SCELP,U,3)
  1.  . L +^DPT(SDFN,"S",SDOEDT):$S($G(DILOCKTM)>0:DILOCKTM,1:5)  ;SD*560 added required timeout
  1.  . D ^DIE K DIE,DR,DA
  1.  . L -^DPT(SDFN,"S",SDOEDT)
  1.  ;
  1.  Q
  1.  ;
  1. ONEELIG() ;
  1.  ;tests for and returns the primary if that is the only eligibility
  1.  ;
  1.  N VAEL
  1.  D ELIG^VADPT
  1.  Q $S($O(VAEL(1,0)):0,1:VAEL(1))
  1.  ;