DGFSMOUT ;SLC/RM - FORMER OTH PP PATIENT UTILITY ; November 9, 2020@3:51 pm
;;5.3;Registration;**1034,1035**;Aug 13, 1993;Build 14
;
;Global References Supported by ICR# Type
;----------------- ----------------- ---------
; ^DGPT("AAD" 418 (DG is the Custodial Package) Cont. Sub
; ^SCE( 402 Cont. Sub
; ^SCE("ADFN" 402 Cont. Sub.
; ^TMP($J SACC 2.3.2.5.1
; ^TMP("PXKENC" SACC 2.3.2.5.1
;
;External References
;-------------------
; $$GET1^DIQ 2056 Supported
; $$GET1^DIQ(40.8 417 (DG is the Custodial Package) Cont. Sub.
; $$GET1^DIQ(45 418 (DG is the Custodial Package) Cont. Sub.
; $$GET1^DIQ(44 10040 Supported
; GETS^DIQ 2056 Supported
; GETS^DIQ(409.68 402 Cont. Sub
; GETS^DIQ(405 419 (DG is the Custodial Package) Cont. Sub.
; GETS^DIQ(42 10039 (DG is the Custodial Package) Supported
; EN^IBEFSMUT 7202 (DG has permission to access) Private
; RX^PSO52API 4820 Supported
; PSS^PSO59 4827 Supported
; GETENC^PXAPI 1894 Supported
; GETGEN^SDOE 2546 Supported
; $$STA^XUAF4 2171 Supported
;No direct call
Q
;Check if patient should be included in report, using OUTPATIENT ENCOUNTER file #409.68
CHKTREAT(DFN,DGDTF,DGDTT,ARRDIV,FLAG) ;
;Input:
; DFN=IEN in file #2
; DGDTF='From' date entered by user
; DGDTT='To' date entered by user
; ARRDIV is in the format output by utility VAUTOMA
; FLAG 0 Outpatient, 1 Inpatient
;Output:
; RET(DIVISION#,DATE OF ENCOUNTER)=Name of division^Station #^Clinic Name^Clinic Stop Code^Edited Last By^DivisionIEN^OEIEN^PrimaryDx^OriginatingProcess
N DGCO,DGDIV,DGDT,DGIEN,DGOUT,DGSTPCODE,DGCLNCNME,DGSTA,DGLSTEDTBY,TRUE
N PRIMDX,DXNAME,SCCNT,SDOEDATA,DGAPPTDT,DGAPTERR,DGVSTIEN,DGOLDIEN
S (SCCNT,DGOLDIEN)=0
S DGDT="" F S DGDT=$O(^SCE("ADFN",DFN,DGDT),-1) Q:'DGDT!(DGDT<DGDTF) D:(DGDT\1'<DGDTF)&((DGDT\1)'>DGDTT)
. S DGIEN=0 F S DGIEN=$O(^SCE("ADFN",DFN,DGDT,DGIEN)) Q:'DGIEN D
. . K DGOUT D GETS^DIQ(409.68,DGIEN_",",".03;.08;.11;.12","IE","DGOUT")
. . I 'FLAG,$G(DGOUT(409.68,DGIEN_",",.12,"E"))'="CHECKED OUT" Q ;outpatient check
. . I FLAG S TRUE=0 D Q:TRUE ;inpatient check
. . . I $G(DGOUT(409.68,DGIEN_",",.12,"E"))'="INPATIENT APPOINTMENT" S TRUE=1 Q
. . . I +$P($G(^SCE(DGIEN,0)),U,7)<1 S TRUE=1 Q ;inpatient outpatient appointment not checked out
. . S DGDIV=$G(DGOUT(409.68,DGIEN_",",.11,"I")) Q:DGDIV=""
. . S DGSTA=$$STA^XUAF4($$GET1^DIQ(40.8,DGDIV_",",.07,"I")) ;($$GET1^DIQ(40.8 - ICR#417)
. . I DGSTA="" S DGSTA="N/A"
. . S DGSTPCODE=$G(DGOUT(409.68,DGIEN_",",.03,"E"))
. . K SDOEDATA D GETGEN^SDOE(DGIEN,"SDOEDATA") ;this is to extract the location of the encounter
. . S DGCLNCNME=$$GET1^DIQ(44,$P(SDOEDATA(0),U,4)_",",.01,"E") ;clinic name
. . K DGAPPTDT,DGAPTERR D GETS^DIQ(2,DFN_",","1900*","IE","DGAPPTDT","DGAPTERR") ;this is to extract the clinic name or location
. . Q:$D(DGAPTERR)
. . S DGLSTEDTBY=$G(DGAPPTDT(2.98,DGDT_","_DFN_",",19,"E")) ;last user entered by
. . I $G(DGLSTEDTBY)="" D
. . . K ^TMP("PXKENC",$J) D GETENC^PXAPI(DFN,DGDT,$P(SDOEDATA(0),U,4)) ;this is to extract last user edited by if not found in the patient file
. . . S DGVSTIEN=$O(^TMP("PXKENC",$J,""))
. . . S DGLSTEDTBY=$$GET1^DIQ(200,$P(^TMP("PXKENC",$J,DGVSTIEN,"VST",DGVSTIEN,0),U,23)_",",.01)
. . . K ^TMP("PXKENC",$J)
. . D GETPDX^DGOTHFS4(DGIEN) ;extract the primary diagnosis for this outpatient encounter
. . I $G(ARRDIV)=1 D CHKTRSET Q
. . D:$D(ARRDIV(DGDIV)) CHKTRSET
I SCCNT>0 S DGENCNT=DGENCNT-SCCNT
K DGAPPTDT,DGAPTERR
Q
;
CHKTRSET ;
N TMPDATA,ORGPRCTYP
S ORGPRCTYP=$G(DGOUT(409.68,DGIEN_",",.08,"I")) ;if originating process type is not equal to 1, it means that it is not a real appointment
I ORGPRCTYP'=1 D
. I $G(DGAPPTDT(2.98,DGDT_","_DFN_",",.001,"I")) S SCCNT=SCCNT+1 ;regardless if the clinic contains primary or secondary, always count is as 1 DOS
. E D
. . I DGOLDIEN=$P(SDOEDATA(0),U,6) Q ;this is to force to display STANDALONE encounters not related to an appointment. Example: Originating Process Type= STOP CODE ADDITION, CREDIT STOP CODE, etc.
. . S ORGPRCTYP=1
S TMPDATA=DGOUT(409.68,DGIEN_",",.11,"E")_U_DGSTA_U_DGCLNCNME_U_DGSTPCODE_U_DGLSTEDTBY_U_DGDIV_U_DGIEN_U_""_U_PRIMDX_U_+ORGPRCTYP
S DGENCNT=DGENCNT+1
I 'FLAG D
. S @RECORD@(DGDT,DGSTA,409.68,DGENCNT)=TMPDATA ;sort by date of service
. I SORTENCBY=2 S @RECORD1@(DGSTA,DGDT,409.68,DGENCNT)=TMPDATA ;sort by division
E D
. S @RECORD@(DGDT,DGSTA,405,DGENCNT)=TMPDATA
. I SORTENCBY=2 S @RECORD1@(DGSTA,DGDT,405,DGENCNT)=TMPDATA
S DGOLDIEN=DGIEN ;contains the OE IEN primary - this is to determine between the primary and secondary stop code
Q
;
CHECKPTF(DGDFN,DGOTHREGDT,DGELGDTV,LIST) ;check and extract inpatient stay for a patient in File #45
;Input:
; DGDFN=IEN in file #2
; DGOTHREGDT='From' date
; DGELGDTV='To' date
;Output:
; ^TMP($J,LIST,DOS,STATION#,FILENO,RECNT)=Name of division^Station #^Ward Location^Treating Facility^Edited Last By^Division^IEN
N ADMDT,DGOUT,DGOUTERR,DIVINPT,PTFIEN,WRDLOC,WRDIEN,LSTUSR,TRTFCLTY,DGDIV,DGDIVNME,DGSTA,TMPDATA,DSCHRGDT
;find all admissions for a patient.
I $D(^DGPT("AAD",DGDFN)) D
. S ADMDT="" F S ADMDT=$O(^DGPT("AAD",DGDFN,ADMDT)) Q:'+ADMDT D
. . S PTFIEN=0 F S PTFIEN=$O(^DGPT("AAD",DGDFN,ADMDT,PTFIEN)) Q:'PTFIEN D
. . . K TMPDATA
. . . S DSCHRGDT=0
. . . ;check if the admission date is before the patient become OTH. If true, check if the patient has been discharged. If patient still not discharged when they become
. . . ;OTH and then VERIFIED, include that patient. If patient is discharged after receiving VBA adjudication but the admission date is before they become OTH, then include that patient
. . . ;otherwise, the record will be skipped.
. . . S DSCHRGDT=$$GET1^DIQ(45,PTFIEN_",",70,"I") ;discharge date
. . . I (ADMDT\1)<DGOTHREGDT D Q ;the admission date is before the patient become OTH
. . . . I +DSCHRGDT<1 D PTFDATA^DGOTHFSM Q ;no discharge date, patient is still inpatient/admitted in the hospital
. . . . I ADMDT\1<=DGELGDTV,$$CHKDATE^DGOTHFSM(+DSCHRGDT\1,DGOTHREGDT,DGELGDTV) D Q ;patient is discharged on or after adjudication but the admission date is before they become OTH, then include that patient
. . . . . I +$G(DGPPFLGRPT)>0,'$$CHKDATE^DGOTHFSM(+DSCHRGDT\1,DGOTHREGDT,DGELGDTV) Q ;check if the PP inpatient discharged date is within the date range.
. . . . . D PTFDATA^DGOTHFSM
. . . . . D EN^IBEFSMUT(DGDFN,(ADMDT\1),(ADMDT\1),LIST)
. . . . . K @IBOTHSTAT@(350)
. . . . . I $D(@IBOTHSTAT@(399,DGDFN)) D DOS399^DGOTHFS4(399)
. . . . Q:'$$CHKDATE^DGOTHFSM(+DSCHRGDT\1,DGOTHREGDT,DGELGDTV)
. . . . D PTFDATA^DGOTHFSM
. . . I ((ADMDT\1)'<DGOTHREGDT)&((ADMDT\1)'>DGELGDTV) D ;admission date and discharge date is within the date range
. . . . I +DSCHRGDT<1 D PTFDATA^DGOTHFSM Q ;patient is still inpatient not discharge
. . . . D PTFDATA^DGOTHFSM
;after checking if there are any inpatient stay for this patient, check if this patient had any inpatient outpatient encounter. if there is and date is within the date range include the data in the report
D CHKTREAT(DGDFN,DGOTHREGDT,DGELGDTV,.VAUTD,1) ;1 is a flag to determine to process inpatient
Q
;
CHECKIB(LIST,DGOTHREGDT,DGELGDTV) ;check if patient had charges stored in file #350 and #399
N OTHIBDT,OTHIBREC,FILENO,DGDIVIEN,DGDT,DGSTA,DGSTANAME,DGLSTUSR,DGIBSTPCODE,IBOTHSTAT,ACCTYP,TMPDATA,TMPDATA1
D EN^IBEFSMUT(DGDFN,DGOTHREGDT,DGELGDTV,LIST) ;extract the IB STATUS in both file #350 and file #399
I '$G(IBOTHSTAT) S IBOTHSTAT=$NA(^TMP($J,LIST))
F FILENO=350,399 D ;check if patient has entry in file #350 and file #399
. I +$G(@IBOTHSTAT@(FILENO,DGDFN,0))>0 D
. . S OTHIBDT="" F S OTHIBDT=$O(@IBOTHSTAT@(FILENO,OTHIBDT)) Q:OTHIBDT="" D
. . . S OTHIBREC="" F S OTHIBREC=$O(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC)) Q:OTHIBREC="" D
. . . . Q:'$$CHKDATE^DGOTHFSM(OTHIBDT,DGOTHREGDT,DGELGDTV) ;check if the date bill from is within the date range patient became OTH and when PE is verified
. . . . ;otherwise, capture the record for this patient
. . . . S DGDT=OTHIBDT
. . . . K TMPDATA,TMPDATA1
. . . . S TMPDATA1=$G(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC))
. . . . I FILENO=350 D
. . . . . S ACCTYP=$P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U)
. . . . . S DGSTA=$P($P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,8),"-") ;station number (eg. 442)
. . . . . S DGSTANAME=$P($P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,8),"-",2) ;station name (eg. CHEYENNE VA MEDICAL)
. . . . . S DGIBSTPCODE=$P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,9) ;stop code
. . . . . S DGLSTUSR=$P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,10) ;user entered/edit the record
. . . . . S TMPDATA=DGSTANAME_U_DGSTA_U_"NON-VA"_U_$S(DGIBSTPCODE'="":DGIBSTPCODE,1:"N/A")_U_DGLSTUSR_U_DGSTA_U_TMPDATA1
. . . . . S DGENCNT=DGENCNT+1
. . . . . S @RECORD@(DGDT,DGSTA,350,DGENCNT)=TMPDATA ;sort by date of service
. . . . . I SORTENCBY=2 S @RECORD1@(DGSTA,DGDT,350,DGENCNT)=TMPDATA ;sort by division
. . . . I FILENO=399 D
. . . . . S ACCTYP=$P($P($P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,5),";"),":",2)
. . . . . S DGDIVIEN=$P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,8),DGSTA=$$STA^XUAF4($$GET1^DIQ(40.8,DGDIVIEN_",",.07,"I")) ;station number (eg. 442)
. . . . . S DGSTANAME=$$GET1^DIQ(40.8,DGDIVIEN_",",.01,"E") ;station name (eg. CHEYENNE VA MEDICAL)
. . . . . S DGLSTUSR=$P(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,9) ;user entered/edit the record
. . . . . S TMPDATA=DGSTANAME_U_DGSTA_U_"NON-VA"_U_"N/A"_U_DGLSTUSR_U_DGDIVIEN_U_ACCTYP_U_TMPDATA1
. . . . . S DGENCNT=DGENCNT+1
. . . . . S @RECORD@(DGDT,DGSTA,399,DGENCNT)=TMPDATA ;sort by date of service
. . . . . I SORTENCBY=2 S @RECORD1@(DGSTA,DGDT,399,DGENCNT)=TMPDATA ;sort by division
Q
;
CHECKRX(LIST) ;check and extract rx data for this patient
N DGRXNUM,DGRXIEN,DGRELDT,DGDIV,DGSTA,DGSTANAME,DGCLNC,DGLSTUSR
K ^TMP($J,LIST) D RX^PSO52API(DGDFN,LIST,,,"2,R,I,P",DGSORT("DGBEG"),$$FMADD^XLFDT(DGSORT("DGEND"),366)) ;get the medication profile of a patient from PRESCRIPTION file (#52)
I +^TMP($J,LIST,DGDFN,0)<1 K ^TMP($J,LIST) Q
S DGRXNUM="" F S DGRXNUM=$O(^TMP($J,LIST,"B",DGRXNUM)) Q:DGRXNUM="" D
. S DGRXIEN="" F S DGRXIEN=$O(^TMP($J,LIST,"B",DGRXNUM,DGRXIEN)) Q:DGRXIEN="" D
. . ;check if the release date is within the date range
. . S DGRELDT=$P(^TMP($J,LIST,DGDFN,DGRXIEN,31),U) ;original fill released date
. . I +DGRELDT<1,+$P(^TMP($J,LIST,DGDFN,DGRXIEN,32.1),U)>1 S DGRELDT=$P(^TMP($J,LIST,DGDFN,DGRXIEN,32.1),U) ;extract the RETURN TO STOCK date release date/time if the original fill date is missing
. . I $G(DGPPFLGRPT)=1 S DGOTHREGDT=DGSORT("DGBEG"),DGELGDTV=DGSORT("DGEND") ;this for PP multiple report processing
. . S DGCLNC=$P(^TMP($J,LIST,DGDFN,DGRXIEN,5),U,2) ;clinic
. . ;check if the release date is within the date range patient became OTH and when PE is verified
. . I '$$CHKDATE^DGOTHFSM(+DGRELDT\1,DGOTHREGDT,DGELGDTV) D REFILL^DGPPOHUT(LIST),PARTIAL^DGPPDRP1(LIST) Q
. . ;check if the original fill released date is before the patient become OTH, if true, check if the refill is within the date range
. . I +DGRELDT\1<DGOTHREGDT D REFILL^DGPPOHUT(LIST),PARTIAL^DGPPDRP1(LIST) Q
. . I $G(^TMP($J,LIST,DGDFN,DGRXIEN,106))'="" Q ;;this is already handled by IBEFMSUT routine. No need to include this record here and to avoid duplicate record.
. . S DGDIV=$P(^TMP($J,LIST,DGDFN,DGRXIEN,20),U) ;division ien
. . K ^TMP($J,"PSOSITE") D PSS^PSO59(DGDIV,,"PSOSITE") S DGSTA=$G(^TMP($J,"PSOSITE",DGDIV,.06)) ;station/site number
. . S DGSTANAME=$P(^TMP($J,LIST,DGDFN,DGRXIEN,20),U,2) ;division name
. . S DGLSTUSR=$P(^TMP($J,LIST,DGDFN,DGRXIEN,23),U,2) ;pharmacist entered this rx
. . S DGENCNT=DGENCNT+1
. . S @RECORD@(+DGRELDT\1,DGSTA,52,DGENCNT)=DGSTANAME_U_DGSTA_U_$S(DGCLNC'="":DGCLNC,1:"NON-VA")_U_"N/A"_U_DGLSTUSR_U_DGDIV_U_"RX - "_DGRXNUM_":"_DGRXIEN
. . D REFILL^DGPPOHUT(LIST),PARTIAL^DGPPDRP1(LIST)
K ^TMP($J,LIST),^TMP($J,"PSOSITE")
Q
;
IBSTATUS(IBFILENO,DATE) ;extract records from file #350 or file #399
N DGRXDATE,IBCNT,BILLGRP,RSLTFRM,BILCLS,IBRFNUM,IBDIV,ACTYP
N BILCLS,IBRFNUM,IBDIV,RECNUM,DFN399,IBIEN399,TMPDATA,IBIEN409,DGIEN399,DGIEN409
S RECNUM=0
S IBCNT="" F S IBCNT=$O(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)) Q:IBCNT="" D
. I IBFILENO=350 D Q
. . ;Outpatient and inpatient events
. . S (BILLGRP,ACTYP,RSLTFRM,IBDIV,TMPDATA)=""
. . S ACTYP=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U) ;action type
. . I ACTYP["RX" S ACTYP="" Q ;quit if rx
. . S BILLGRP=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,2) ;billing group
. . S RSLTFRM=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,5) ;result from
. . I $P(RSLTFRM,":",1)=44 K @RECORD@(SUB1,SUB2,FILENO,RECNT) Q ;we are not including any file #44 records as of the moment
. . S IBDIV=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,8) ;division
. . I $P(DGSORT("SORTENCBY"),U)=1 S RECNUM=+$O(@RECORD@(ENCDT\1,+STATNUM,IBFILENO,RECNUM)) ;sort by date of service
. . I $P(DGSORT("SORTENCBY"),U)=2 S RECNUM=+$O(@RECORD@(+STATNUM,ENCDT\1,IBFILENO,RECNUM)) ;sort by division
. . I ($P(RSLTFRM,":",1)=405)!($P(RSLTFRM,":",1)=409.68)!($P(RSLTFRM,":",1)=45) D
. . . I $P(RSLTFRM,":",1)=45 S DFN405=$P($P(@RECORD@(SUB1,SUB2,FILENO,RECNT),U,8),";",2) ;reset DFN405 to extract the IEN for file #45
. . . I DFN405=$P(RSLTFRM,":",2)!(DFN409=$P(RSLTFRM,":",2)) D ;DFN405 and DFN409 is set in ENCTRIB^DGOTHFS3
. . . . S CHRGCNT=CHRGCNT+1
. . . . S TMPDATA=@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)
. . . . I $P(DGSORT("SORTENCBY"),U)=1 D ;sort by date of service
. . . . . S @RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT)=TMPDATA
. . . . . S TMPDATA=$P($P(@RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT),U,4),"-",2)
. . . . . S $P(@RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT),U,4)=TMPDATA
. . . . . K @RECORD@(ENCDT\1,+STATNUM,IBFILENO,RECNUM) ;remove the record from ^TMP if it already exist in either file 405 or 409.68
. . . . I $P(DGSORT("SORTENCBY"),U)=2 D ;sort by division
. . . . . S @RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT)=TMPDATA
. . . . . S TMPDATA=$P($P(@RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT),U,4),"-",2)
. . . . . S $P(@RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT),U,4)=TMPDATA
. . . . . K @RECORD@(+STATNUM,ENCDT\1,IBFILENO,RECNUM) ;remove the record from ^TMP if it already exist in either file 405 or 409.68
. I IBFILENO=399 D
. . ;Outpatient and inpatient events
. . S (BILLGRP,RSLTFRM,BILCLS,IBDIV,TMPDATA,IBIEN399,IBIEN409,DGIEN399,DGIEN409)=""
. . Q:$P($P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,5),":")=3 ;quit if rx
. . I +DFN405>0,$P($P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,5),":")'=1 Q ;quit if we are no longer dealing with the inpatient record currently
. . S BILCLS=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U) ;bill classification
. . S BILLGRP=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,2) ;rate type
. . S IBIEN399=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,3) ;file #399 ien
. . S IBIEN409=$P(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,10) ;this can contain either ien from file #409.68 or file #45
. . I $P(DGSORT("SORTENCBY"),U)=1 D ;sort by date of service
. . . I $D(@RECORD@(DATE\1,STATNUM,IBFILENO)) D
. . . . I DFN405=IBIEN409!(DFN409=IBIEN409) D
. . . . . S RECNUM=$O(@RECORD@(DATE\1,STATNUM,IBFILENO,""))
. . . . . S DGIEN399=$P(@RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM),U,10) ;file #399 ien
. . . . . S DGIEN409=$P(@RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM),U,17) ;this can contain either ien from file #409.68 or file #45
. . . . . I DGIEN409=IBIEN409!(DGIEN399=IBIEN399) D
. . . . . . I $D(@RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM)) K @RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM) ;remove the record from ^TMP if it already exist in either file 405 or 409.68
. . . . . . S CHRGCNT=CHRGCNT+1
. . . . . . S TMPDATA=@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)
. . . . . . S @RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT)=TMPDATA
. . I $P(DGSORT("SORTENCBY"),U)=2 D ;sort by division
. . . I $D(@RECORD@(STATNUM,DATE\1,IBFILENO)) D
. . . . I DFN405=IBIEN409!(DFN409=IBIEN409) D
. . . . . S RECNUM=$O(@RECORD@(STATNUM,DATE\1,IBFILENO,""))
. . . . . S DGIEN399=$P(@RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM),U,10) ;file #399 ien
. . . . . S DGIEN409=$P(@RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM),U,17) ;file #409 ien
. . . . . I DGIEN409=IBIEN409!(DGIEN399=IBIEN399) D
. . . . . . I $D(@RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM)) K @RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM) ;remove the record from ^TMP if it already exist in either file 405 or 409.68
. . . . . . S CHRGCNT=CHRGCNT+1
. . . . . . S TMPDATA=@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)
. . . . . . S @RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT)=TMPDATA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGFSMOUT 17436 printed Sep 23, 2025@20:19:27 Page 2
DGFSMOUT ;SLC/RM - FORMER OTH PP PATIENT UTILITY ; November 9, 2020@3:51 pm
+1 ;;5.3;Registration;**1034,1035**;Aug 13, 1993;Build 14
+2 ;
+3 ;Global References Supported by ICR# Type
+4 ;----------------- ----------------- ---------
+5 ; ^DGPT("AAD" 418 (DG is the Custodial Package) Cont. Sub
+6 ; ^SCE( 402 Cont. Sub
+7 ; ^SCE("ADFN" 402 Cont. Sub.
+8 ; ^TMP($J SACC 2.3.2.5.1
+9 ; ^TMP("PXKENC" SACC 2.3.2.5.1
+10 ;
+11 ;External References
+12 ;-------------------
+13 ; $$GET1^DIQ 2056 Supported
+14 ; $$GET1^DIQ(40.8 417 (DG is the Custodial Package) Cont. Sub.
+15 ; $$GET1^DIQ(45 418 (DG is the Custodial Package) Cont. Sub.
+16 ; $$GET1^DIQ(44 10040 Supported
+17 ; GETS^DIQ 2056 Supported
+18 ; GETS^DIQ(409.68 402 Cont. Sub
+19 ; GETS^DIQ(405 419 (DG is the Custodial Package) Cont. Sub.
+20 ; GETS^DIQ(42 10039 (DG is the Custodial Package) Supported
+21 ; EN^IBEFSMUT 7202 (DG has permission to access) Private
+22 ; RX^PSO52API 4820 Supported
+23 ; PSS^PSO59 4827 Supported
+24 ; GETENC^PXAPI 1894 Supported
+25 ; GETGEN^SDOE 2546 Supported
+26 ; $$STA^XUAF4 2171 Supported
+27 ;No direct call
+28 QUIT
+29 ;Check if patient should be included in report, using OUTPATIENT ENCOUNTER file #409.68
CHKTREAT(DFN,DGDTF,DGDTT,ARRDIV,FLAG) ;
+1 ;Input:
+2 ; DFN=IEN in file #2
+3 ; DGDTF='From' date entered by user
+4 ; DGDTT='To' date entered by user
+5 ; ARRDIV is in the format output by utility VAUTOMA
+6 ; FLAG 0 Outpatient, 1 Inpatient
+7 ;Output:
+8 ; RET(DIVISION#,DATE OF ENCOUNTER)=Name of division^Station #^Clinic Name^Clinic Stop Code^Edited Last By^DivisionIEN^OEIEN^PrimaryDx^OriginatingProcess
+9 NEW DGCO,DGDIV,DGDT,DGIEN,DGOUT,DGSTPCODE,DGCLNCNME,DGSTA,DGLSTEDTBY,TRUE
+10 NEW PRIMDX,DXNAME,SCCNT,SDOEDATA,DGAPPTDT,DGAPTERR,DGVSTIEN,DGOLDIEN
+11 SET (SCCNT,DGOLDIEN)=0
+12 SET DGDT=""
FOR
SET DGDT=$ORDER(^SCE("ADFN",DFN,DGDT),-1)
if 'DGDT!(DGDT<DGDTF)
QUIT
if (DGDT\1'<DGDTF)&((DGDT\1)'>DGDTT)
Begin DoDot:1
+13 SET DGIEN=0
FOR
SET DGIEN=$ORDER(^SCE("ADFN",DFN,DGDT,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:2
+14 KILL DGOUT
DO GETS^DIQ(409.68,DGIEN_",",".03;.08;.11;.12","IE","DGOUT")
+15 ;outpatient check
IF 'FLAG
IF $GET(DGOUT(409.68,DGIEN_",",.12,"E"))'="CHECKED OUT"
QUIT
+16 ;inpatient check
IF FLAG
SET TRUE=0
Begin DoDot:3
+17 IF $GET(DGOUT(409.68,DGIEN_",",.12,"E"))'="INPATIENT APPOINTMENT"
SET TRUE=1
QUIT
+18 ;inpatient outpatient appointment not checked out
IF +$PIECE($GET(^SCE(DGIEN,0)),U,7)<1
SET TRUE=1
QUIT
End DoDot:3
if TRUE
QUIT
+19 SET DGDIV=$GET(DGOUT(409.68,DGIEN_",",.11,"I"))
if DGDIV=""
QUIT
+20 ;($$GET1^DIQ(40.8 - ICR#417)
SET DGSTA=$$STA^XUAF4($$GET1^DIQ(40.8,DGDIV_",",.07,"I"))
+21 IF DGSTA=""
SET DGSTA="N/A"
+22 SET DGSTPCODE=$GET(DGOUT(409.68,DGIEN_",",.03,"E"))
+23 ;this is to extract the location of the encounter
KILL SDOEDATA
DO GETGEN^SDOE(DGIEN,"SDOEDATA")
+24 ;clinic name
SET DGCLNCNME=$$GET1^DIQ(44,$PIECE(SDOEDATA(0),U,4)_",",.01,"E")
+25 ;this is to extract the clinic name or location
KILL DGAPPTDT,DGAPTERR
DO GETS^DIQ(2,DFN_",","1900*","IE","DGAPPTDT","DGAPTERR")
+26 if $DATA(DGAPTERR)
QUIT
+27 ;last user entered by
SET DGLSTEDTBY=$GET(DGAPPTDT(2.98,DGDT_","_DFN_",",19,"E"))
+28 IF $GET(DGLSTEDTBY)=""
Begin DoDot:3
+29 ;this is to extract last user edited by if not found in the patient file
KILL ^TMP("PXKENC",$JOB)
DO GETENC^PXAPI(DFN,DGDT,$PIECE(SDOEDATA(0),U,4))
+30 SET DGVSTIEN=$ORDER(^TMP("PXKENC",$JOB,""))
+31 SET DGLSTEDTBY=$$GET1^DIQ(200,$PIECE(^TMP("PXKENC",$JOB,DGVSTIEN,"VST",DGVSTIEN,0),U,23)_",",.01)
+32 KILL ^TMP("PXKENC",$JOB)
End DoDot:3
+33 ;extract the primary diagnosis for this outpatient encounter
DO GETPDX^DGOTHFS4(DGIEN)
+34 IF $GET(ARRDIV)=1
DO CHKTRSET
QUIT
+35 if $DATA(ARRDIV(DGDIV))
DO CHKTRSET
End DoDot:2
End DoDot:1
+36 IF SCCNT>0
SET DGENCNT=DGENCNT-SCCNT
+37 KILL DGAPPTDT,DGAPTERR
+38 QUIT
+39 ;
CHKTRSET ;
+1 NEW TMPDATA,ORGPRCTYP
+2 ;if originating process type is not equal to 1, it means that it is not a real appointment
SET ORGPRCTYP=$GET(DGOUT(409.68,DGIEN_",",.08,"I"))
+3 IF ORGPRCTYP'=1
Begin DoDot:1
+4 ;regardless if the clinic contains primary or secondary, always count is as 1 DOS
IF $GET(DGAPPTDT(2.98,DGDT_","_DFN_",",.001,"I"))
SET SCCNT=SCCNT+1
+5 IF '$TEST
Begin DoDot:2
+6 ;this is to force to display STANDALONE encounters not related to an appointment. Example: Originating Process Type= STOP CODE ADDITION, CREDIT STOP CODE, etc.
IF DGOLDIEN=$PIECE(SDOEDATA(0),U,6)
QUIT
+7 SET ORGPRCTYP=1
End DoDot:2
End DoDot:1
+8 SET TMPDATA=DGOUT(409.68,DGIEN_",",.11,"E")_U_DGSTA_U_DGCLNCNME_U_DGSTPCODE_U_DGLSTEDTBY_U_DGDIV_U_DGIEN_U_""_U_PRIMDX_U_+ORGPRCTYP
+9 SET DGENCNT=DGENCNT+1
+10 IF 'FLAG
Begin DoDot:1
+11 ;sort by date of service
SET @RECORD@(DGDT,DGSTA,409.68,DGENCNT)=TMPDATA
+12 ;sort by division
IF SORTENCBY=2
SET @RECORD1@(DGSTA,DGDT,409.68,DGENCNT)=TMPDATA
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET @RECORD@(DGDT,DGSTA,405,DGENCNT)=TMPDATA
+15 IF SORTENCBY=2
SET @RECORD1@(DGSTA,DGDT,405,DGENCNT)=TMPDATA
End DoDot:1
+16 ;contains the OE IEN primary - this is to determine between the primary and secondary stop code
SET DGOLDIEN=DGIEN
+17 QUIT
+18 ;
CHECKPTF(DGDFN,DGOTHREGDT,DGELGDTV,LIST) ;check and extract inpatient stay for a patient in File #45
+1 ;Input:
+2 ; DGDFN=IEN in file #2
+3 ; DGOTHREGDT='From' date
+4 ; DGELGDTV='To' date
+5 ;Output:
+6 ; ^TMP($J,LIST,DOS,STATION#,FILENO,RECNT)=Name of division^Station #^Ward Location^Treating Facility^Edited Last By^Division^IEN
+7 NEW ADMDT,DGOUT,DGOUTERR,DIVINPT,PTFIEN,WRDLOC,WRDIEN,LSTUSR,TRTFCLTY,DGDIV,DGDIVNME,DGSTA,TMPDATA,DSCHRGDT
+8 ;find all admissions for a patient.
+9 IF $DATA(^DGPT("AAD",DGDFN))
Begin DoDot:1
+10 SET ADMDT=""
FOR
SET ADMDT=$ORDER(^DGPT("AAD",DGDFN,ADMDT))
if '+ADMDT
QUIT
Begin DoDot:2
+11 SET PTFIEN=0
FOR
SET PTFIEN=$ORDER(^DGPT("AAD",DGDFN,ADMDT,PTFIEN))
if 'PTFIEN
QUIT
Begin DoDot:3
+12 KILL TMPDATA
+13 SET DSCHRGDT=0
+14 ;check if the admission date is before the patient become OTH. If true, check if the patient has been discharged. If patient still not discharged when they become
+15 ;OTH and then VERIFIED, include that patient. If patient is discharged after receiving VBA adjudication but the admission date is before they become OTH, then include that patient
+16 ;otherwise, the record will be skipped.
+17 ;discharge date
SET DSCHRGDT=$$GET1^DIQ(45,PTFIEN_",",70,"I")
+18 ;the admission date is before the patient become OTH
IF (ADMDT\1)<DGOTHREGDT
Begin DoDot:4
+19 ;no discharge date, patient is still inpatient/admitted in the hospital
IF +DSCHRGDT<1
DO PTFDATA^DGOTHFSM
QUIT
+20 ;patient is discharged on or after adjudication but the admission date is before they become OTH, then include that patient
IF ADMDT\1<=DGELGDTV
IF $$CHKDATE^DGOTHFSM(+DSCHRGDT\1,DGOTHREGDT,DGELGDTV)
Begin DoDot:5
+21 ;check if the PP inpatient discharged date is within the date range.
IF +$GET(DGPPFLGRPT)>0
IF '$$CHKDATE^DGOTHFSM(+DSCHRGDT\1,DGOTHREGDT,DGELGDTV)
QUIT
+22 DO PTFDATA^DGOTHFSM
+23 DO EN^IBEFSMUT(DGDFN,(ADMDT\1),(ADMDT\1),LIST)
+24 KILL @IBOTHSTAT@(350)
+25 IF $DATA(@IBOTHSTAT@(399,DGDFN))
DO DOS399^DGOTHFS4(399)
End DoDot:5
QUIT
+26 if '$$CHKDATE^DGOTHFSM(+DSCHRGDT\1,DGOTHREGDT,DGELGDTV)
QUIT
+27 DO PTFDATA^DGOTHFSM
End DoDot:4
QUIT
+28 ;admission date and discharge date is within the date range
IF ((ADMDT\1)'<DGOTHREGDT)&((ADMDT\1)'>DGELGDTV)
Begin DoDot:4
+29 ;patient is still inpatient not discharge
IF +DSCHRGDT<1
DO PTFDATA^DGOTHFSM
QUIT
+30 DO PTFDATA^DGOTHFSM
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;after checking if there are any inpatient stay for this patient, check if this patient had any inpatient outpatient encounter. if there is and date is within the date range include the data in the report
+32 ;1 is a flag to determine to process inpatient
DO CHKTREAT(DGDFN,DGOTHREGDT,DGELGDTV,.VAUTD,1)
+33 QUIT
+34 ;
CHECKIB(LIST,DGOTHREGDT,DGELGDTV) ;check if patient had charges stored in file #350 and #399
+1 NEW OTHIBDT,OTHIBREC,FILENO,DGDIVIEN,DGDT,DGSTA,DGSTANAME,DGLSTUSR,DGIBSTPCODE,IBOTHSTAT,ACCTYP,TMPDATA,TMPDATA1
+2 ;extract the IB STATUS in both file #350 and file #399
DO EN^IBEFSMUT(DGDFN,DGOTHREGDT,DGELGDTV,LIST)
+3 IF '$GET(IBOTHSTAT)
SET IBOTHSTAT=$NAME(^TMP($JOB,LIST))
+4 ;check if patient has entry in file #350 and file #399
FOR FILENO=350,399
Begin DoDot:1
+5 IF +$GET(@IBOTHSTAT@(FILENO,DGDFN,0))>0
Begin DoDot:2
+6 SET OTHIBDT=""
FOR
SET OTHIBDT=$ORDER(@IBOTHSTAT@(FILENO,OTHIBDT))
if OTHIBDT=""
QUIT
Begin DoDot:3
+7 SET OTHIBREC=""
FOR
SET OTHIBREC=$ORDER(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC))
if OTHIBREC=""
QUIT
Begin DoDot:4
+8 ;check if the date bill from is within the date range patient became OTH and when PE is verified
if '$$CHKDATE^DGOTHFSM(OTHIBDT,DGOTHREGDT,DGELGDTV)
QUIT
+9 ;otherwise, capture the record for this patient
+10 SET DGDT=OTHIBDT
+11 KILL TMPDATA,TMPDATA1
+12 SET TMPDATA1=$GET(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC))
+13 IF FILENO=350
Begin DoDot:5
+14 SET ACCTYP=$PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U)
+15 ;station number (eg. 442)
SET DGSTA=$PIECE($PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,8),"-")
+16 ;station name (eg. CHEYENNE VA MEDICAL)
SET DGSTANAME=$PIECE($PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,8),"-",2)
+17 ;stop code
SET DGIBSTPCODE=$PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,9)
+18 ;user entered/edit the record
SET DGLSTUSR=$PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,10)
+19 SET TMPDATA=DGSTANAME_U_DGSTA_U_"NON-VA"_U_$SELECT(DGIBSTPCODE'="":DGIBSTPCODE,1:"N/A")_U_DGLSTUSR_U_DGSTA_U_TMPDATA1
+20 SET DGENCNT=DGENCNT+1
+21 ;sort by date of service
SET @RECORD@(DGDT,DGSTA,350,DGENCNT)=TMPDATA
+22 ;sort by division
IF SORTENCBY=2
SET @RECORD1@(DGSTA,DGDT,350,DGENCNT)=TMPDATA
End DoDot:5
+23 IF FILENO=399
Begin DoDot:5
+24 SET ACCTYP=$PIECE($PIECE($PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,5),";"),":",2)
+25 ;station number (eg. 442)
SET DGDIVIEN=$PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,8)
SET DGSTA=$$STA^XUAF4($$GET1^DIQ(40.8,DGDIVIEN_",",.07,"I"))
+26 ;station name (eg. CHEYENNE VA MEDICAL)
SET DGSTANAME=$$GET1^DIQ(40.8,DGDIVIEN_",",.01,"E")
+27 ;user entered/edit the record
SET DGLSTUSR=$PIECE(@IBOTHSTAT@(FILENO,OTHIBDT,DGDFN,OTHIBREC),U,9)
+28 SET TMPDATA=DGSTANAME_U_DGSTA_U_"NON-VA"_U_"N/A"_U_DGLSTUSR_U_DGDIVIEN_U_ACCTYP_U_TMPDATA1
+29 SET DGENCNT=DGENCNT+1
+30 ;sort by date of service
SET @RECORD@(DGDT,DGSTA,399,DGENCNT)=TMPDATA
+31 ;sort by division
IF SORTENCBY=2
SET @RECORD1@(DGSTA,DGDT,399,DGENCNT)=TMPDATA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
CHECKRX(LIST) ;check and extract rx data for this patient
+1 NEW DGRXNUM,DGRXIEN,DGRELDT,DGDIV,DGSTA,DGSTANAME,DGCLNC,DGLSTUSR
+2 ;get the medication profile of a patient from PRESCRIPTION file (#52)
KILL ^TMP($JOB,LIST)
DO RX^PSO52API(DGDFN,LIST,,,"2,R,I,P",DGSORT("DGBEG"),$$FMADD^XLFDT(DGSORT("DGEND"),366))
+3 IF +^TMP($JOB,LIST,DGDFN,0)<1
KILL ^TMP($JOB,LIST)
QUIT
+4 SET DGRXNUM=""
FOR
SET DGRXNUM=$ORDER(^TMP($JOB,LIST,"B",DGRXNUM))
if DGRXNUM=""
QUIT
Begin DoDot:1
+5 SET DGRXIEN=""
FOR
SET DGRXIEN=$ORDER(^TMP($JOB,LIST,"B",DGRXNUM,DGRXIEN))
if DGRXIEN=""
QUIT
Begin DoDot:2
+6 ;check if the release date is within the date range
+7 ;original fill released date
SET DGRELDT=$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,31),U)
+8 ;extract the RETURN TO STOCK date release date/time if the original fill date is missing
IF +DGRELDT<1
IF +$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,32.1),U)>1
SET DGRELDT=$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,32.1),U)
+9 ;this for PP multiple report processing
IF $GET(DGPPFLGRPT)=1
SET DGOTHREGDT=DGSORT("DGBEG")
SET DGELGDTV=DGSORT("DGEND")
+10 ;clinic
SET DGCLNC=$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,5),U,2)
+11 ;check if the release date is within the date range patient became OTH and when PE is verified
+12 IF '$$CHKDATE^DGOTHFSM(+DGRELDT\1,DGOTHREGDT,DGELGDTV)
DO REFILL^DGPPOHUT(LIST)
DO PARTIAL^DGPPDRP1(LIST)
QUIT
+13 ;check if the original fill released date is before the patient become OTH, if true, check if the refill is within the date range
+14 IF +DGRELDT\1<DGOTHREGDT
DO REFILL^DGPPOHUT(LIST)
DO PARTIAL^DGPPDRP1(LIST)
QUIT
+15 ;;this is already handled by IBEFMSUT routine. No need to include this record here and to avoid duplicate record.
IF $GET(^TMP($JOB,LIST,DGDFN,DGRXIEN,106))'=""
QUIT
+16 ;division ien
SET DGDIV=$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,20),U)
+17 ;station/site number
KILL ^TMP($JOB,"PSOSITE")
DO PSS^PSO59(DGDIV,,"PSOSITE")
SET DGSTA=$GET(^TMP($JOB,"PSOSITE",DGDIV,.06))
+18 ;division name
SET DGSTANAME=$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,20),U,2)
+19 ;pharmacist entered this rx
SET DGLSTUSR=$PIECE(^TMP($JOB,LIST,DGDFN,DGRXIEN,23),U,2)
+20 SET DGENCNT=DGENCNT+1
+21 SET @RECORD@(+DGRELDT\1,DGSTA,52,DGENCNT)=DGSTANAME_U_DGSTA_U_$SELECT(DGCLNC'="":DGCLNC,1:"NON-VA")_U_"N/A"_U_DGLSTUSR_U_DGDIV_U_"RX - "_DGRXNUM_":"_DGRXIEN
+22 DO REFILL^DGPPOHUT(LIST)
DO PARTIAL^DGPPDRP1(LIST)
End DoDot:2
End DoDot:1
+23 KILL ^TMP($JOB,LIST),^TMP($JOB,"PSOSITE")
+24 QUIT
+25 ;
IBSTATUS(IBFILENO,DATE) ;extract records from file #350 or file #399
+1 NEW DGRXDATE,IBCNT,BILLGRP,RSLTFRM,BILCLS,IBRFNUM,IBDIV,ACTYP
+2 NEW BILCLS,IBRFNUM,IBDIV,RECNUM,DFN399,IBIEN399,TMPDATA,IBIEN409,DGIEN399,DGIEN409
+3 SET RECNUM=0
+4 SET IBCNT=""
FOR
SET IBCNT=$ORDER(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT))
if IBCNT=""
QUIT
Begin DoDot:1
+5 IF IBFILENO=350
Begin DoDot:2
+6 ;Outpatient and inpatient events
+7 SET (BILLGRP,ACTYP,RSLTFRM,IBDIV,TMPDATA)=""
+8 ;action type
SET ACTYP=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U)
+9 ;quit if rx
IF ACTYP["RX"
SET ACTYP=""
QUIT
+10 ;billing group
SET BILLGRP=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,2)
+11 ;result from
SET RSLTFRM=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,5)
+12 ;we are not including any file #44 records as of the moment
IF $PIECE(RSLTFRM,":",1)=44
KILL @RECORD@(SUB1,SUB2,FILENO,RECNT)
QUIT
+13 ;division
SET IBDIV=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,8)
+14 ;sort by date of service
IF $PIECE(DGSORT("SORTENCBY"),U)=1
SET RECNUM=+$ORDER(@RECORD@(ENCDT\1,+STATNUM,IBFILENO,RECNUM))
+15 ;sort by division
IF $PIECE(DGSORT("SORTENCBY"),U)=2
SET RECNUM=+$ORDER(@RECORD@(+STATNUM,ENCDT\1,IBFILENO,RECNUM))
+16 IF ($PIECE(RSLTFRM,":",1)=405)!($PIECE(RSLTFRM,":",1)=409.68)!($PIECE(RSLTFRM,":",1)=45)
Begin DoDot:3
+17 ;reset DFN405 to extract the IEN for file #45
IF $PIECE(RSLTFRM,":",1)=45
SET DFN405=$PIECE($PIECE(@RECORD@(SUB1,SUB2,FILENO,RECNT),U,8),";",2)
+18 ;DFN405 and DFN409 is set in ENCTRIB^DGOTHFS3
IF DFN405=$PIECE(RSLTFRM,":",2)!(DFN409=$PIECE(RSLTFRM,":",2))
Begin DoDot:4
+19 SET CHRGCNT=CHRGCNT+1
+20 SET TMPDATA=@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)
+21 ;sort by date of service
IF $PIECE(DGSORT("SORTENCBY"),U)=1
Begin DoDot:5
+22 SET @RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT)=TMPDATA
+23 SET TMPDATA=$PIECE($PIECE(@RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT),U,4),"-",2)
+24 SET $PIECE(@RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT),U,4)=TMPDATA
+25 ;remove the record from ^TMP if it already exist in either file 405 or 409.68
KILL @RECORD@(ENCDT\1,+STATNUM,IBFILENO,RECNUM)
End DoDot:5
+26 ;sort by division
IF $PIECE(DGSORT("SORTENCBY"),U)=2
Begin DoDot:5
+27 SET @RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT)=TMPDATA
+28 SET TMPDATA=$PIECE($PIECE(@RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT),U,4),"-",2)
+29 SET $PIECE(@RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT),U,4)=TMPDATA
+30 ;remove the record from ^TMP if it already exist in either file 405 or 409.68
KILL @RECORD@(+STATNUM,ENCDT\1,IBFILENO,RECNUM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+31 IF IBFILENO=399
Begin DoDot:2
+32 ;Outpatient and inpatient events
+33 SET (BILLGRP,RSLTFRM,BILCLS,IBDIV,TMPDATA,IBIEN399,IBIEN409,DGIEN399,DGIEN409)=""
+34 ;quit if rx
if $PIECE($PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,5),"
QUIT
+35 ;quit if we are no longer dealing with the inpatient record currently
IF +DFN405>0
IF $PIECE($PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,5),":")'=1
QUIT
+36 ;bill classification
SET BILCLS=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U)
+37 ;rate type
SET BILLGRP=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,2)
+38 ;file #399 ien
SET IBIEN399=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,3)
+39 ;this can contain either ien from file #409.68 or file #45
SET IBIEN409=$PIECE(@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT),U,10)
+40 ;sort by date of service
IF $PIECE(DGSORT("SORTENCBY"),U)=1
Begin DoDot:3
+41 IF $DATA(@RECORD@(DATE\1,STATNUM,IBFILENO))
Begin DoDot:4
+42 IF DFN405=IBIEN409!(DFN409=IBIEN409)
Begin DoDot:5
+43 SET RECNUM=$ORDER(@RECORD@(DATE\1,STATNUM,IBFILENO,""))
+44 ;file #399 ien
SET DGIEN399=$PIECE(@RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM),U,10)
+45 ;this can contain either ien from file #409.68 or file #45
SET DGIEN409=$PIECE(@RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM),U,17)
+46 IF DGIEN409=IBIEN409!(DGIEN399=IBIEN399)
Begin DoDot:6
+47 ;remove the record from ^TMP if it already exist in either file 405 or 409.68
IF $DATA(@RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM))
KILL @RECORD@(DATE\1,STATNUM,IBFILENO,RECNUM)
+48 SET CHRGCNT=CHRGCNT+1
+49 SET TMPDATA=@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)
+50 SET @RECORD@(ENCDT,STATNUM,FILENO,RECNT,CHRGCNT)=TMPDATA
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+51 ;sort by division
IF $PIECE(DGSORT("SORTENCBY"),U)=2
Begin DoDot:3
+52 IF $DATA(@RECORD@(STATNUM,DATE\1,IBFILENO))
Begin DoDot:4
+53 IF DFN405=IBIEN409!(DFN409=IBIEN409)
Begin DoDot:5
+54 SET RECNUM=$ORDER(@RECORD@(STATNUM,DATE\1,IBFILENO,""))
+55 ;file #399 ien
SET DGIEN399=$PIECE(@RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM),U,10)
+56 ;file #409 ien
SET DGIEN409=$PIECE(@RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM),U,17)
+57 IF DGIEN409=IBIEN409!(DGIEN399=IBIEN399)
Begin DoDot:6
+58 ;remove the record from ^TMP if it already exist in either file 405 or 409.68
IF $DATA(@RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM))
KILL @RECORD@(STATNUM,DATE\1,IBFILENO,RECNUM)
+59 SET CHRGCNT=CHRGCNT+1
+60 SET TMPDATA=@IBOTHSTAT@(IBFILENO,DATE\1,DFN,IBCNT)
+61 SET @RECORD@(STATNUM,ENCDT,FILENO,RECNT,CHRGCNT)=TMPDATA
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+62 QUIT
+63 ;
