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

PXCOMPACT.m

Go to the documentation of this file.
  1. PXCOMPACT ;ALB/BPA,CMC - Routine for COMPACT Act APIs;05/06/2024@12:01
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**240**;Aug 12, 1996;Build 55
  1. ; *240* APIs for Episode of Care APIs (^PXCOMP(818))
  1. ; Reference to $$ELIG^DGCOMPACTELIG in ICR #7462
  1. ; Reference to SETPTFFLG^DGCOMPACT and SETPTFMVMT^DGCOMPACT in ICR #7463
  1. ; Reference to ^DGPM("ATID3") in ICR #17
  1. ;
  1. Q
  1. GETSTDT(DFN) ;
  1. ; Retrieve the start date from the zero level of the most current episode sequence
  1. ; DFN is the Patient ID
  1. ;
  1. N PXEOCNUM,PXEOCSEQ,PXSTDT
  1. S (PXEOCNUM,PXEOCSEQ,PXERRMSG,PXSTDT)=""
  1. ;D VALDFN(DFN,.PXERRMSG) I PXERRMSG'="" Q PXERRMSG
  1. I $D(^PXCOMP(818,"B",DFN)) D
  1. . S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN),PXSTDT=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",1)
  1. Q PXSTDT
  1. ;
  1. GETIPDT(DFN) ;
  1. ;Retrieve the IP benefit end date
  1. ;
  1. N PXEOCNUM,PXEOCSEQ,IPENDDT
  1. S (PXEOCNUM,PXEOCSEQ,IPENDDT)=""
  1. I $D(^PXCOMP(818,"B",DFN)) D
  1. . S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN),IPENDDT=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)
  1. Q IPENDDT
  1. ;
  1. GETEOC(DFN) ;
  1. ; Get the Episode of Care number assigned to the patient
  1. N PXEOCNUM
  1. I DFN="" S PXEOCNUM=""
  1. E S PXEOCNUM=$O(^PXCOMP(818,"B",DFN,""))
  1. Q PXEOCNUM
  1. ;
  1. GETEOCSEQ(DFN) ;
  1. ; Get the current/last Episode of Care sequence
  1. N PXEOCNUM,PXEOCSEQ
  1. S PXEOCSEQ="",PXEOCNUM=$$GETEOC(DFN)
  1. I $G(PXEOCNUM)'="",$D(^PXCOMP(818,PXEOCNUM,10,0)) S PXEOCSEQ=$O(^PXCOMP(818,PXEOCNUM,10,"B"),-1)
  1. Q PXEOCSEQ
  1. ;
  1. GETPOINTRSEQ(DFN,PXENC,PXTY) ;
  1. ; Get the pointer sequence from the episode of care
  1. ; DFN - Internal Patient ID *required
  1. ; PXENC - Internal Encounter ID (VISIT or PTF) *required
  1. ; PXTY - Inpatient or Outpatient
  1. N PXEOCNUM,PXEOCSEQ,PXPONTRNUM
  1. S PXPONTRNUM=""
  1. I $G(PXTY)="" S PXTY=$$GETBENTYP(DFN)
  1. S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN)
  1. I PXEOCNUM'="",PXTY'="" D
  1. . I PXTY="O" S PXPONTRNUM=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,"B",PXENC,""))
  1. . E S PXPONTRNUM=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,"B",PXENC,""))
  1. Q PXPONTRNUM
  1. ;
  1. GETBENTYP(DFN) ;
  1. N PXBENTYP,PXEOCNUM,PXEOCSEQ
  1. S PXEOCNUM=$$GETEOC(DFN)
  1. I PXEOCNUM'="" S PXBENTYP=$P(^PXCOMP(818,PXEOCNUM,0),"^",3)
  1. ; If there is no value in the benefit type field for a closed episode of care,
  1. ; look at the benefit end date history
  1. I PXBENTYP="" D
  1. . ; Default setting to outpatient
  1. . S PXEOCSEQ=$$GETEOCSEQ(DFN),PXBENTYP="O"
  1. . ; Look for the inpatient benefit end date and outpatient benefit end date to
  1. . ; determine a closed episode of care benefit type
  1. . I $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)'="",$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",5)="" S PXBENTYP="I"
  1. Q PXBENTYP
  1. ;
  1. SETSTDT(DFN,PXNWSTDT) ;
  1. ; Set a new start date for the current / most recent episode of care
  1. ; DFN - Patient ID
  1. ; PXNWSTDT - New start date (VA format)
  1. ;
  1. N CDATA,CMPMSG,PXBENTYP,PXEOCNUM,PXEOCSEQ,PXERRMSG,PXFNDOBI,PXFNDOBO,PXIENS
  1. S (CDATA,CMPMSG,PXBENTYP,PXEOCNUM,PXEOCSEQ,PXERRMSG,PXFNDOBI,PXFNDOBO,PXIENS)=""
  1. ;
  1. ; Check to see if date is less than seven digits in length
  1. I $L(PXNWSTDT)<7 S PXERRMSG="The start date value "_PXNWSTDT_" is less than seven digits in length." D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. ; Check to see if date is more than seven digits in length
  1. I $L(PXNWSTDT)>7 S PXERRMSG="The start date value "_PXNWSTDT_" is greater than seven digits in length." D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. ; Check to see if the start date is prior to January 17th, 2023
  1. I PXNWSTDT<3230117 S PXERRMSG="The start date "_PXNWSTDT_" is prior to January 17th, 2023." D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. ; Check to see if start date is in the future
  1. I PXNWSTDT>DT S PXERRMSG="The start date "_PXNWSTDT_" is in the future." D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. ;
  1. D VALDFN(DFN,.PXERRMSG) I PXERRMSG'="" Q
  1. S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN),PXBENTYP=$$GETBENTYP(DFN)
  1. I PXBENTYP="I" S PXFNDOBI=$$FMADD^XLFDT(PXNWSTDT,29)
  1. I PXBENTYP="O" S PXFNDOBO=$$FMADD^XLFDT(PXNWSTDT,89)
  1. S PXIENS=PXEOCSEQ_","_PXEOCNUM_","
  1. ;
  1. I $G(PXNWSTDT)'="" S CDATA(818.01,PXIENS,.01)=PXNWSTDT
  1. I $G(PXFNDOBI)'="" S CDATA(818.01,PXIENS,4)=PXFNDOBI
  1. I $G(PXFNDOBO)'="" S CDATA(818.01,PXIENS,5)=PXFNDOBO
  1. D FILE^DIE("","CDATA","CMPMSG")
  1. I $D(CMPMSG("DIERR")) D FILEMANERR^PXCOMPACT1(DFN,.CDATA,.CMPMSG) Q
  1. Q
  1. ;
  1. SETENDDT(DFN,PXENDDT,PXENDSRC,PXAUTH,PXCOMM) ;
  1. N PXEOCNUM,PXEOCSEQ,PXERRMSG,PXSTDT
  1. S (PXEOCNUM,PXEOCSEQ,PXERRMSG,PXSTDT)=""
  1. D VALDFN(DFN,.PXERRMSG) I PXERRMSG'="" Q
  1. I $G(PXENDDT)="" Q
  1. I $G(PXAUTH)'="" D VALUSR(PXAUTH,.PXERRMSG) I PXERRMSG'="" Q
  1. ;
  1. S PXENDSRC=$S($G(PXENDSRC)="PA":"PA",$G(PXENDSRC)="PR":"PR",$G(PXENDSRC)="TE":"TE",1:"")
  1. ;
  1. S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN)
  1. S PXSTDT=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^")
  1. I PXSTDT>PXENDDT Q
  1. ;
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",2)=PXENDDT
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",3)=PXENDSRC
  1. I $P(^PXCOMP(818,PXEOCNUM,0),"^",3)="I" S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)=PXENDDT
  1. I $P(^PXCOMP(818,PXEOCNUM,0),"^",3)="O" S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",5)=PXENDDT
  1. I $G(PXAUTH)'="" S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1),"^",1)=PXAUTH
  1. I $G(PXCOMM)'="" S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1),"^",2)=PXCOMM
  1. ; Set the ACUTE SUICIDAL CRISIS FLAG to zero and benefit type flag to NULL
  1. S $P(^PXCOMP(818,PXEOCNUM,0),"^",2)=0,$P(^PXCOMP(818,PXEOCNUM,0),"^",3)=""
  1. Q
  1. ;
  1. NEWEOC(DFN,PXENC,PXTY,PXSTDT,PXSRC) ;
  1. ; API to input a new Episode of Care
  1. ;
  1. N CDATA,CMPMSG,EPDATA,PXELIG,PXEOCNUM,PXEOCSEQ,PXERRMSG,PXFNDOBI,PXFNDOBO,PXIEN,PXIENEP,PXTYCHK
  1. S (CDATA,CMPMSG,EPDATA,PXELIG,PXEOCNUM,PXEOCSEQ,PXERRMSG,PXFNDOBI,PXFNDOBO,PXIEN,PXIENEP,PXTYCHK)=""
  1. I $G(DFN)="" S PXERRMSG="Patient ID (DFN) cannot be null" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. I '$D(^DPT(DFN)) S PXERRMSG="Patient is invalid, not in the patient file #2" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. S PXTYCHK=$S($G(PXTY)="I":1,$G(PXTY)="O":1,1:0)
  1. I PXTYCHK=0 S PXERRMSG="Inpatient (I) or Outpatient (O) must be the designated type" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. I PXENC="" S PXERRMSG="The encounter value can not be null" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. I $D(^PXCOMP(818,"B",DFN)) D
  1. . S PXEOCNUM=$$GETEOC(DFN)
  1. . I $P(^PXCOMP(818,PXEOCNUM,0),"^",2)=1 S PXERRMSG="Patient has an open episode" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN)
  1. I PXERRMSG'="" Q
  1. ; If the start date is not passed in, use the start date of the encounter
  1. I $D(^DGPT(PXENC)),$G(PXSTDT)="",$G(PXTY)="I" S PXSTDT=$P($P(^DGPT(PXENC,0),"^",2),".")
  1. I $D(^AUPNVSIT(PXENC)),$G(PXSTDT)="",$G(PXTY)="O" S PXSTDT=$P($P(^AUPNVSIT(PXENC,0),"^"),".")
  1. I $G(PXSTDT)="" S PXSTDT=DT
  1. S PXELIG=$$ELIG^DGCOMPACTELIG(DFN,"PXCOMPACT")
  1. S PXELIG=$S(PXELIG="ELIGIBLE":"E",PXELIG="NOT ELIGIBLE":"N",1:"U")
  1. I $G(PXSRC)="" S PXSRC=""
  1. I PXTY="I" S PXFNDOBI=$$FMADD^XLFDT(PXSTDT,29)
  1. I PXTY="O" S PXFNDOBO=$$FMADD^XLFDT(PXSTDT,90)
  1. ;Set top level of ^PXCOMP
  1. I $G(PXEOCNUM)="" D
  1. . N CDATA,CMPMSG,PXIEN
  1. . S PXIEN="?+1,"
  1. . S CDATA(818,PXIEN,.01)=DFN
  1. . S CDATA(818,PXIEN,2)=1
  1. . S CDATA(818,PXIEN,3)=PXTY
  1. . D UPDATE^DIE("","CDATA","","CMPMSG")
  1. . I $D(CMPMSG("DIERR")) D FILEMANERR^PXCOMPACT1(DFN,.CDATA,.CMPMSG) Q
  1. E D
  1. . S $P(^PXCOMP(818,PXEOCNUM,0),"^",2)=1
  1. . S $P(^PXCOMP(818,PXEOCNUM,0),"^",3)=PXTY
  1. ;
  1. I $D(CMPMSG("DIERR")) Q
  1. I PXEOCNUM="" S PXEOCNUM=$$GETEOC(DFN)
  1. ;
  1. ;Set episode level (10)
  1. S PXIENEP="?+1,"_PXEOCNUM_","
  1. I $G(PXSTDT)'="" S EPDATA(818.01,PXIENEP,.01)=PXSTDT
  1. I $G(PXFNDOBI)'="" S EPDATA(818.01,PXIENEP,4)=PXFNDOBI
  1. I $G(PXFNDOBO)'="" S EPDATA(818.01,PXIENEP,5)=PXFNDOBO
  1. I $G(PXSRC)'="" S EPDATA(818.01,PXIENEP,7)=PXSRC
  1. I $G(PXELIG)'="" S EPDATA(818.01,PXIENEP,8)=PXELIG
  1. D UPDATE^DIE("","EPDATA","","CMPMSG")
  1. I $D(CMPMSG("DIERR")) D FILEMANERR^PXCOMPACT1(DFN,.EPDATA,.CMPMSG)
  1. ;
  1. S (PXEOCNUM,PXEOCSEQ)=""
  1. S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN)
  1. I $G(PXELIG)'="" S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)=PXELIG
  1. ; CALL 40/41 API HERE
  1. D VISIT(PXENC,PXTY,PXEOCNUM,DFN)
  1. Q
  1. ;
  1. CHGTYPSTAT(DFN,PXTY,PXCHNGDT) ;
  1. N PXEOCNUM,PXEOCSEQ,PXFNDOBI,PXFNDOBO
  1. S (PXFNDOBI,PXFNDOBO)=""
  1. S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN)
  1. I PXEOCNUM="" Q
  1. ;
  1. I $$GETBENTYP(DFN)=PXTY Q
  1. I $G(PXCHNGDT)="" S PXCHNGDT=DT
  1. S $P(^PXCOMP(818,PXEOCNUM,0),"^",3)=PXTY
  1. ; Set the updated benefit end dates based on the type of change
  1. I PXTY="O" S PXFNDOBI=PXCHNGDT,PXFNDOBO=$$FMADD^XLFDT(PXCHNGDT,90)
  1. I PXTY="I" S PXFNDOBO=PXCHNGDT,PXFNDOBI=$$FMADD^XLFDT(PXCHNGDT,29)
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)=PXFNDOBI
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",5)=PXFNDOBO
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",7)="A"
  1. Q
  1. ;
  1. VISIT(ENC,PXTY,PXEOCNUM,DFN) ;
  1. ;
  1. N CDATA,CMPMSG,PXIENS,PXEOCSEQ
  1. S (PXIENS)=""
  1. S PXEOCSEQ=$$GETEOCSEQ(DFN)
  1. I PXTY="I" D
  1. . S (CMPMSG,CDATA(818.04))=""
  1. . ;Set top level 40 node for PTF pointer
  1. . S PXIENS="?+1,"_PXEOCSEQ_","_PXEOCNUM_","
  1. . I $G(ENC)'="" D
  1. . . S CDATA(818.04,PXIENS,.01)=ENC
  1. . . D UPDATE^DIE("","CDATA","","CMPMSG")
  1. . . I $D(CMPMSG("DIERR")) D FILEMANERR^PXCOMPACT1(DFN,.CDATA,.CMPMSG)
  1. . . I $D(^DGPT(ENC,0)) D SETPTFFLG^DGCOMPACT(ENC,1)
  1. I PXTY="O" D
  1. . S (CMPMSG,CDATA(818.141))=""
  1. . ;Set top level 41 node for VISIT pointer
  1. . S PXIENS="?+1,"_PXEOCSEQ_","_PXEOCNUM_","
  1. . I $G(ENC)'="" D
  1. . . S CDATA(818.141,PXIENS,.01)=ENC
  1. . . D UPDATE^DIE("","CDATA","","CMPMSG")
  1. . . I $D(CMPMSG("DIERR")) D FILEMANERR^PXCOMPACT1(DFN,.CDATA,.CMPMSG)
  1. . . D SETVSTFLG(DFN,ENC,1)
  1. Q
  1. ;
  1. SETVSTFLG(DFN,PXENC,PXVAL) ;
  1. N PXEOCNUM,PXEOCSEQ,PXPOINTRSEQ
  1. S PXEOCNUM=$$GETEOC(DFN),PXEOCSEQ=$$GETEOCSEQ(DFN),PXPOINTRSEQ=$$GETPOINTRSEQ(DFN,PXENC,"O")
  1. I PXPOINTRSEQ'="" S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXPOINTRSEQ,0),"^",2)=PXVAL
  1. Q
  1. ;
  1. VALDFN(DFN,PXERRMSG) ;
  1. N PXERRMSG
  1. S PXERRMSG=""
  1. I DFN="" S PXERRMSG="Patient required" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. I '$D(^DPT(DFN)) S PXERRMSG="Patient is invalid, not in the patient file #2" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. I '$D(^PXCOMP(818,"B",DFN)) S PXERRMSG="Patient is not in the COMPACT Act Episode of Care file #818" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. Q
  1. ;
  1. VALUSR(PXAUTH,PXERRMSG) ;
  1. N PXERRMSG
  1. S PXERRMSG=""
  1. I PXAUTH="" S PXERRMSG="User value can not be null" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. I '$D(^VA(200,PXAUTH,0)) S PXERRMSG="Invalid user "_PXAUTH_", not in the new person file #200" D COMPACTERR^PXCOMPACT1(PXERRMSG,DFN) Q
  1. Q
  1. ;
  1. ASC(DFN) ;
  1. ; Determine if patient is currently in an acute suicidal crisis
  1. N PXEOCNUM,ASC
  1. S PXEOCNUM="",PXEOCNUM=$$GETEOC(DFN),ASC="N"
  1. I PXEOCNUM,$P(^PXCOMP(818,PXEOCNUM,0),"^",2)>0 S ASC="Y"
  1. Q ASC
  1. ;
  1. DISPLAY(DFN) ;
  1. ;before calling this tag, verify eligibility by calling ELIG^DGCOMPACTELIG(DFN)
  1. ;if ELIGIBLE or UNDETERMINED, call this tag
  1. N DISPLAY,ELIGSEQ,ENDDT,EOCTYP,IPBENEND,OPBENEND,OPEXT,PXIEN,PXLASTSEQ,PXNUMOPX,PXSEQ,STARTDT
  1. S (ENDDT,EOCTYP,IPBENEND,OPBENEND,OPEXT,PXIEN,PXLASTSEQ,PXNUMOPX,PXSEQ,STARTDT,ELIGSEQ,DISPLAY)=""
  1. ;get Compact Act sequence
  1. I $D(^PXCOMP(818,"B",DFN)) S PXSEQ=$$GETEOC(DFN)
  1. I PXSEQ'="" D
  1. . ;find the latest sequence in the episode
  1. . S PXLASTSEQ=$$GETEOCSEQ(DFN)
  1. . ;get the start date and format it
  1. . S STARTDT=$P(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,0),"^",1),STARTDT=$$FMTE^XLFDT(STARTDT)
  1. . S EOCTYP=$P(^PXCOMP(818,PXSEQ,0),"^",3)
  1. . ;check if the episode has ended. If so, only display Episode Start and End Date
  1. . S ENDDT=$P($G(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,0)),"^",2)
  1. . S IPBENEND=$P($G(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,0)),"^",4) I IPBENEND'="" S IPBENEND=$$FMTE^XLFDT(IPBENEND)
  1. . S OPBENEND=$P($G(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,0)),"^",5) I OPBENEND'="" S OPBENEND=$$FMTE^XLFDT(OPBENEND)
  1. . I ENDDT'="" D
  1. . . S ENDDT=$$FMTE^XLFDT(ENDDT)
  1. . . ;check for extensions
  1. . . S OPEXT=$D(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,30))
  1. . . I OPEXT=0 D
  1. . . . S DISPLAY="COMPACT Act Start Date^"_STARTDT_"^End Date^"_ENDDT_"^IP Benefit End Date^"_IPBENEND_"^OP Benefit end date^"_OPBENEND
  1. . . . ; if there's an extension, display extension start and episode end date
  1. . . I OPEXT D
  1. . . . S STARTDT=$P($G(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,30,1,0)),"^",1),STARTDT=$$FMTE^XLFDT(STARTDT)
  1. . . . S DISPLAY="Extension Start Date^"_STARTDT_"^Episode End Date^"_ENDDT
  1. . ;if not ended, display Episode Start Date and Remaining Days (if no extensions)
  1. . E D
  1. . . ;check for extensions
  1. . . S OPEXT=$D(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,30))
  1. . . I OPEXT=0 D
  1. . . . S PXIEN=PXLASTSEQ_","_PXSEQ
  1. . . . I EOCTYP="I",$P(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,0),"^",4)'="" D
  1. . . . . S DISPLAY="COMPACT Act Start Date^"_STARTDT_"^Remaining Days^"_$$GET1^DIQ(818.01,PXIEN,42)_"^Inpatient Benefit End Date^"_IPBENEND
  1. . . . E S DISPLAY="COMPACT Act Start Date^"_STARTDT_"^Remaining Days^"_$S(EOCTYP="O":$$GET1^DIQ(818.01,PXIEN,43),1:$$GET1^DIQ(818.01,PXIEN,42))
  1. . . I OPEXT D
  1. . . . S STARTDT=$P($G(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,30,1,0)),"^",1),STARTDT=$$FMTE^XLFDT(STARTDT)
  1. . . . S PXNUMOPX=$P(^PXCOMP(818,PXSEQ,10,PXLASTSEQ,30,0),"^",3),PXIEN=PXNUMOPX_","_PXLASTSEQ_","_PXSEQ
  1. . . . S DISPLAY="Extension Start Date^"_STARTDT_"^Remaining Days^"_$S(EOCTYP="O":$$GET1^DIQ(818.01,PXIEN,43),1:$$GET1^DIQ(818.01,PXIEN,42))
  1. Q DISPLAY
  1. ;
  1. ADMIT(DFN,STARTDT,ADMIT,PTF) ;
  1. ;called from DGPM ADMIT input template
  1. ;first, close the episode of care IF it's outpatient
  1. N EOCNUM,EOCSEQ,LTD,REOPNFLG
  1. S (EOCNUM,EOCSEQ)="",REOPNFLG=0
  1. S EOCNUM=$$GETEOC(DFN)
  1. I EOCNUM="" D NEWEOC(DFN,PTF,"I",STARTDT,"V") I ADMIT="F" D SETPTFMVMT^DGCOMPACT(PTF,"Y")
  1. ;Processing complete, new episode of care created
  1. I EOCNUM="" Q
  1. S EOCSEQ=$$GETEOCSEQ(DFN) I EOCSEQ="" Q
  1. ;
  1. ;checking for scenario where patient is discharged but admitted same day
  1. I $P(^PXCOMP(818,EOCNUM,0),"^",3)="O",$P(^PXCOMP(818,EOCNUM,0),"^",2)=1 D
  1. . ; - get the last discharge date
  1. . S LTD=+$O(^DGPM("ATID3",DFN,"")) S:LTD LTD=9999999.9999999-LTD\1
  1. . ;Processing for patient that has been discharged/admitted the same day
  1. . I DT=LTD D REOPNEOC(EOCNUM,EOCSEQ,"") S REOPNFLG=1
  1. . I REOPNFLG=0 D SETENDDT(DFN,DT,"PR",DUZ,"admitting")
  1. ;if a current inpatient EOC exists do the following:
  1. ;link both PTF records to the episode
  1. I $P(^PXCOMP(818,EOCNUM,0),"^",3)="I",$P(^PXCOMP(818,EOCNUM,0),"^",2)=1 D
  1. . D VISIT(PTF,"I",EOCNUM,DFN)
  1. . D SETPTFMVMT^DGCOMPACT(PTF,"Y")
  1. ;if no current EOC inpatient record
  1. I $P(^PXCOMP(818,EOCNUM,0),"^",2)=0 D
  1. . D NEWEOC(DFN,PTF,"I",STARTDT,"V")
  1. . ;set movement for Full admit
  1. . I ADMIT="F" D SETPTFMVMT^DGCOMPACT(PTF,"Y")
  1. Q
  1. ;
  1. REOPNEOC(PXEOCNUM,PXEOCSEQ,STARTDT) ;
  1. N DFN,ELIG S (DFN,ELIG)=""
  1. ; Reopen an inpatient Episode of Care
  1. S $P(^PXCOMP(818,PXEOCNUM,0),"^",2)=1 ;Reset the episode of care open/close flag
  1. S $P(^PXCOMP(818,PXEOCNUM,0),"^",3)="I" ;Reset the Benefit Type
  1. ; Start date processing needs benefit type
  1. S DFN=$P(^PXCOMP(818,PXEOCNUM,0),"^",1)
  1. I $G(STARTDT)="" S STARTDT=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",1)
  1. E D SETSTDT(DFN,STARTDT)
  1. ;
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",2)="" ;Remove the end date
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",3)="" ;Remove the end source
  1. I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1)) K ^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1)
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)=$$FMADD^XLFDT(STARTDT,29) ;Reset the inpatient benefit end date
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",5)="" ;Remove the outpatient benefit end date
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",6)="" ;Remove the final status
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",7)="" ;Remove the source
  1. S ELIG=$$ELIG^DGCOMPACTELIG(DFN,"PXCOMPACT")
  1. S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)=$S(ELIG="ELIGIBLE":"E",ELIG="NOT ELIGIBLE":"N",1:"U") ;Reset the patient eligibility
  1. Q
  1. ;