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

BKMVA2.m

Go to the documentation of this file. 
  1. BKMVA2 ;PRXM/HC/JGH - HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 20 Sep 2005  9:27 AM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1. INIT ; EP - Review/Edit Patient Record
  1.  N TEXT,DFN,BKMLOCAL,PNT,HRN,DFN,AGE,SEX,ADDRESS,HMPHONE,WKPHONE,DOB,RES
  1.  N STAT,DGCT,INITHIV,INITAIDS,LASTVIST,NEXTVIST,RID,CLCL,OPIA,ALLERGY,BKMDOD
  1.  N REM,ACRF,HIVCMGR,EDDT,PCPROV,HIVPROV,CRDT ;,CLDT
  1.  S VALMCNT=0,VALMAR="^TMP(""BKMVA1"","_$J_")",VALM0=""
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT," ")
  1.  ;
  1.  S DFN=^TMP("BKMLKP",$J),BKMLOCAL=^TMP("BKMLKP",$J,DFN),PNT=$P(BKMLOCAL,U,1),HRN=$P(BKMLOCAL,U,2)
  1.  S DOB=$$FMTE^XLFDT($P(BKMLOCAL,U,3),1)
  1.  S AGE=$P($G(BKMLOCAL),U,5),SEX=$P($G(BKMLOCAL),U,4)
  1.  ; The variable RCRDHDR is used in sub-screens as the header.
  1.  S RCRDHDR=$$PAD^BKMIXX4("Patient: ",">"," ",16)_$$PAD^BKMIXX4(PNT,">"," ",34)_$$PAD^BKMIXX4("HRN: ",">"," ",16)_$$PAD^BKMIXX4(HRN,">"," ",34)
  1.  ;
  1.  D GETALL(DFN,0)
  1.  S TEXT=$$PAD^BKMIXX4("HRN: ",">"," ",16)_$$PAD^BKMIXX4(HRN,">"," ",34)
  1.  I $G(BKMDOD)'="" S TEXT=TEXT_$$PAD^BKMIXX4(" DOD: ",">"," ",7)_$$PAD^BKMIXX4($$FMTE^XLFDT($G(BKMDOD)\1),">"," ",23)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Patient: ",">"," ",16)_$$PAD^BKMIXX4(PNT,">"," ",34)_$$PAD^BKMIXX4(" Age: ",">"," ",7)_$$PAD^BKMIXX4(AGE,">"," ",7)_" Gender: "_$$PAD^BKMIXX4(SEX,">"," ",7)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Address: ",">"," ",16)_$$PAD^BKMIXX4(ADDRESS,">"," ",64)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Home Phone: ",">"," ",16)_$$PAD^BKMIXX4(HMPHONE,">"," ",34)_$$PAD^BKMIXX4(" DOB: ",">"," ",7)_$$PAD^BKMIXX4(DOB,">"," ",23)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Work Phone: ",">"," ",16)_$$PAD^BKMIXX4(WKPHONE,">"," ",34)_$$PAD^BKMIXX4(" Comm: ",">"," ",7)_$$PAD^BKMIXX4(RES,">"," ",23)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  ;
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT," ")
  1.  ;
  1.  S TEXT=$$PAD^BKMIXX4("Register Status: ",">"," ",17)_$$PAD^BKMIXX4(STAT,">"," ",18)  ;_$$PAD^BKMIXX4(" Register ID: ",">"," ",18)_$$PAD^BKMIXX4(RID,">"," ",27)
  1.  ;Register ID Removed by client request 
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Current DX: ",">"," ",17)_$$PAD^BKMIXX4(DGCT,">"," ",18)_$$PAD^BKMIXX4(" Clinical Class: ",">"," ",18)_$$PAD^BKMIXX4(CLCL,">"," ",27)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Initial HIV DX: ",">"," ",17)_$$PAD^BKMIXX4(INITHIV,">"," ",18)_$$PAD^BKMIXX4(" Initial AIDS DX: ",">"," ",18)_$$PAD^BKMIXX4(INITAIDS,">"," ",27)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Last Visit: ",">"," ",17)_$$PAD^BKMIXX4(LASTVIST,">"," ",18)_$$PAD^BKMIXX4(" Next Visit: ",">"," ",18)_$$PAD^BKMIXX4(NEXTVIST,">"," ",27)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  ;
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT," ")
  1.  ;
  1.  ;PRXM/HC/DLS 9/20/2005 Removed 'Care' from 'HIV Care Provider'.
  1.  S TEXT=$$PAD^BKMIXX4("HIV Provider: ",">"," ",19)_$$PAD^BKMIXX4(HIVPROV,">"," ",16)_$$PAD^BKMIXX4(" HIV Case Manager: ",">"," ",21)_$$PAD^BKMIXX4(HIVCMGR,">"," ",26)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Designated Primary Care Provider: ",">"," ",34)_$$PAD^BKMIXX4(PCPROV,">"," ",46)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4("Record Created: ",">"," ",19)_$$PAD^BKMIXX4(CRDT,">"," ",16)_$$PAD^BKMIXX4(" Record Last Edited: ",">"," ",21)_$$PAD^BKMIXX4(EDDT,">"," ",16)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  ;
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT," ")
  1.  ;
  1.  S TEXT=$$PAD^BKMIXX4(OPIA,">"," ",80)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT="Allergies: "_$$PAD^BKMIXX4($S(ALLERGY:"Known",1:"Unknown"),">"," ",80)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S REM=$G(^TMP("BKMVA2R",$J,DFN,"REM"))
  1.  S TEXT=$$PAD^BKMIXX4(REM,">"," ",80)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  S TEXT=$$PAD^BKMIXX4(ACRF,">"," ",80)
  1.  S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,TEXT)
  1.  Q
  1.  ;
  1.  ; ******************************************************************************
  1.  ; The following are the "Add Patient Data" Screen labels.
  1. ADDDATA(DFN) ;EP - Add Patient Data
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  ;PRXM/HC/BHS - 12/29/2005 - Removed security check here - enforced within each option
  1.  ;I '$$BKMPRIV^BKMIXX3(DUZ) D NOGO^BKMIXX3 Q
  1.  N EXIT,ENTER,RCRDHDR,BKMDOD
  1.  ; create scratch area record in file 90459
  1.  D NSCRATCH
  1.  D ^XBFMK
  1.  S EXIT=0
  1.  F  D  Q:EXIT
  1.  . D CLEAR^VALM1
  1.  . D FULL^VALM1
  1.  . S RCRDHDR=$$PAD^BKMIXX4(" Patient: ",">"," ",10)_$$PAD^BKMIXX4($$GET1^DIQ(2,DFN,".01","E"),">"," ",30)_$$PAD^BKMIXX4(" HRN: ",">"," ",6)_$$PAD^BKMIXX4($$HRN^BKMVA1(DFN),">"," ",9)
  1.  . S BKMDOD=$$GET1^DIQ(2,DFN,".351","I")
  1.  . I BKMDOD'="" S RCRDHDR=RCRDHDR_$$PAD^BKMIXX4(" DOD: ",">"," ",6)_$$PAD^BKMIXX4($$FMTE^XLFDT(BKMDOD,1),">"," ",15)
  1.  . W !,RCRDHDR
  1.  . K DIR
  1.  . ;PRXM/HC/BHS - 05/08/2006 - Removed 'Add ' from descriptions per IHS
  1.  . S DIR(0)="SO^1:Exams;2:Health Factors;3:Immunizations;4:Lab Tests;5:Medications;6:Measurements;7:Patient Education;8:Procedures;9:Radiology;10:Skin Tests"
  1.  . S DIR("A")="Select Action"
  1.  . D ^DIR
  1.  . I Y?1."^"!(Y?." ")!(Y'>0) S EXIT=1 Q
  1.  . ;PRXM/HC/DLS 9/20/2005 Care option under 'Add Patient Data'
  1.  . ; removed at the request of the client.
  1.  . ;I Y=1 D FREVEDIT^BKMVA1("EN^BKMVD1","EN^BKMVD11",".16") Q  ; Elder Care
  1.  . I Y=1 D FREVEDIT^BKMVA1("EN^BKMVD2","EN^BKMVD21",".17") Q  ; Exams
  1.  . I Y=2 D FREVEDIT^BKMVA1("EN^BKMVD3","EN^BKMVD31",".18") Q  ; Health Factors
  1.  . I Y=3 D FREVEDIT^BKMVA1("EN^BKMVD8","EN^BKMVD81",".23") Q  ; Immunizations
  1.  . I Y=4 D FREVEDIT^BKMVA1("EN^BKMVA4","EN^BKMVA41",".13") Q  ; Lab Tests
  1.  . I Y=5 D FREVEDIT^BKMVA1("EN^BKMVA5","EN^BKMVA51",".14") Q  ; Medications 
  1.  . I Y=6 D FREVEDIT^BKMVA1("EN^BKMVD4","EN^BKMVD41",".19") Q  ; Measurements
  1.  . I Y=7 D FREVEDIT^BKMVA1("EN^BKMVA6","EN^BKMVA61",".12") Q  ; Patient Education
  1.  . I Y=8 D FREVEDIT^BKMVA1("EN^BKMVD5","EN^BKMVD51",".2") Q  ; Procedures 
  1.  . I Y=9 D FREVEDIT^BKMVA1("EN^BKMVD6","EN^BKMVD61",".21") Q   ; Radiology
  1.  . I Y=10 D FREVEDIT^BKMVA1("EN^BKMVD7","EN^BKMVD71",".22") Q   ; Skin Tests
  1.  . W !,"Invalid Input" S EXIT=$$PAUSE^BKMIXX3
  1.  D ^XBFMK
  1.  ; delete scratch area record in file 90459
  1.  D DSCRATCH
  1.  K ^TMP("BKMVA1",$J)
  1.  ; Set up listman display variables and build listman display array
  1.  I '$$GETALL^BKMVA1(DFN) Q
  1.  D INIT
  1.  Q
  1. NSCRATCH ;
  1.  D ^XBFMK
  1.  I $D(^BKM(90459,"B",$J)) D DSCRATCH
  1.  K DINUM,DA N DIFILE
  1.  S X=$J
  1.  S DIC(0)="E",DIC("DR")=".02////"_DFN
  1.  S (DIFILE,DIC)="^BKM(90459,",DLAYGO=90459
  1.  D FILE^DICN
  1.  D ^XBFMK
  1.  Q
  1. DSCRATCH ;
  1.  D ^XBFMK
  1.  S DA=$O(^BKM(90459,"B",$J,""))
  1.  I DA="" Q
  1.  S DIK="^BKM(90459,"
  1.  D ^DIK
  1.  D ^XBFMK
  1.  Q
  1. GETALL(DFN,CALCREM) ;EP
  1.  ;
  1.  ; The following routine gathers all of the data required by the label INIT.
  1.  ; The variable DFN is the patients DFN in file 2 or 9000001.
  1.  ; The variable CALCREM, isn't required, but indicates that the reminders should be
  1.  ; recalculated.
  1.  N HIVIEN,BKMIEN,BKMREG,ADD1,CITY,STATE,ZIP,LCSZ,BKMCLCL,SCHEDULE,LASTVSTI,NEXTVSTI
  1.  N ICD9S,BKMIENS,EDIEN,DGCTI,RVSTDT
  1.  ; PRX/DLS 3/30/06 -Removed NEW of REMLIST
  1.  ; N REMLIST
  1.  K ^TMP("BKMLKP",$J)
  1.  D BASETMP^BKMIXX3(DFN)
  1.  S CALCREM=$G(CALCREM)
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  Q:BKMIEN="" 0 ; There is no HIV register
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  Q:HIVIEN="" 0 ; There is no HMS register defined
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  Q:BKMREG="" 0 ; This patient is not on the HIV register.
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  I BKMIENS="" Q 0
  1.  ;S RID=$$GET1^DIQ("90451",BKMIEN_",",".05","E") ;;COMMENTED OUT DUE TO CLIENT REQUEST FOR REMOVAL
  1.  ; DAOU/BHS - 08/03/2005 - Reset HRN because existing HRN="" caused <SUBSCRIPT> error
  1.  ;I '$D(^AUPNPAT("D",$G(HRN,0),DFN)) S HRN=$$HRN^BKMVA1(DFN) ; ^AUPNPAT("D",HRN,DFN,#)
  1.  S HRN=$$HRN^BKMVA1(DFN)
  1.  ; Date of death
  1.  S BKMDOD=$$GET1^DIQ(2,DFN,".351","I")
  1.  ; 
  1.  S ADD1=$$ADDRESS^BKMVA1(DFN)
  1.  S CITY=$P(ADD1,U,4)
  1.  S STATE=$P(ADD1,U,5)
  1.  S ZIP=$P(ADD1,U,6)
  1.  S LCSZ=$L(CITY)+$L(STATE)+$L(ZIP)
  1.  S ADDRESS=$S(LCSZ'<77:"",1:$E($P(ADD1,U,1),1,80-LCSZ))
  1.  S ADDRESS=$E($P(ADD1,U,1),1,80-($L(CITY)+$L(STATE)+$L(ZIP)))_","_CITY_","_STATE_","_ZIP
  1.  ; PRX/DLS 4/11/06 ; If there is no address info, suppress the commas. Otherwise, display them.
  1.  I ADDRESS=",,," S ADDRESS=""
  1.  S HMPHONE=$$PHONE^BKMVA1(DFN,1)
  1.  S WKPHONE=$$PHONE^BKMVA1(DFN,2)
  1.  ;
  1.  S RES=$$RES^BKMVA1(DFN)
  1.  ;
  1.  ;S CRDT=$P($G(^BKM(90451,BKMIEN,1,BKMREG,0)),U,3)
  1.  S CRDT=$$GET1^DIQ(90451.01,BKMIENS,".02","I")
  1.  S CRDT=$S(CRDT="":"",1:$$FMTE^XLFDT(CRDT\1,1))
  1.  S EDIEN=$O(^BKM(90451,BKMIEN,1,BKMREG,9,""),-1)
  1.  S EDDT=$S(EDIEN="":"",1:$$GET1^DIQ(90451.05,EDIEN_","_BKMIENS,.01,"I"))
  1.  S EDDT=$S(EDDT="":"",1:$$FMTE^XLFDT(EDDT\1,1))
  1.  ;S BKMCLCL=$P($G(^BKM(90451,BKMIEN,1,BKMREG,2)),U,1)
  1.  ;S CLCL=$S(BKMCLCL="":"",$E(BKMCLCL,1)?1A:BKMCLCL,1:$P($G(^BKMV(90451.7,BKMCLCL,0)),U,1))
  1.  S CLCL=$$GET1^DIQ(90451.01,BKMIENS,"3","E")
  1.  ;S DGCT=$P($G(^BKM(90451,BKMIEN,1,BKMREG,3)),U,7)
  1.  S DGCTI=$$GET1^DIQ(90451.01,BKMIENS,"2.3","I")
  1.  S DGCT=$S($$GET1^DIQ(90451.01,BKMIENS,"2.3","E")?1"AT RISK".E:"AT RISK-"_$S(DGCTI="EU":"UNK",DGCTI="EI":"IN",DGCTI="EO":"OCC",DGCTI="EN":"NON",1:""),1:$$GET1^DIQ(90451.01,BKMIENS,"2.3","E"))
  1.  ;I $L(DGCT)=1 S DGCT=$S(DGCT="H":"HIV",DGCT="A":"AIDS",DGCT="R":"AT RISK",DGCT["E":"EXPOSED",1:"**")
  1.  ;S CLDT=$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMIENS,3.5,"I"),5) ; Clinical Classification Date
  1.  ;
  1.  ; Check to see if the calculated next date is scheduled, if not check for other future scheduled date.
  1.  S (LASTVIST,NEXTVIST,SCHEDULE,RVSTDT,LASTVSTI)=""
  1.  ; Last visit prior to today
  1.  ;PRXM/HC/BHS - 9/20/2005 - Replace with last visit rather than appt per client 9/9
  1.  ;S LASTVSTI=$O(^DPT(DFN,"S",DT),-1)
  1.  ;S RVSTDT=$O(^AUPNVSIT("AA",DFN,""))
  1.  ;I RVSTDT'="" S LASTVSTI=$O(^AUPNVSIT("AA",DFN,RVSTDT,""))
  1.  ;I LASTVSTI'="" S LASTVSTI=$$GET1^DIQ(9000010,LASTVSTI_",",".01","I")
  1.  ;PRXM/HC/BHS - 12/01/2005 - Replace with function call based on new filter logic to find appropriate visit
  1.  S LASTVSTI=$$LSTVST(DFN)
  1.  ; Next scheduled visit after today
  1.  S NEXTVSTI=$O(^DPT(DFN,"S",DT))
  1.  I NEXTVSTI?7N.1".".N S SCHEDULE=1
  1.  ; If no last visit and no next visit, next visit is 100 days from today
  1.  I LASTVSTI'?7N.1".".N S LASTVSTI="" I NEXTVSTI'?7N.1".".N S NEXTVSTI=$$FMADD^XLFDT(DT,100)
  1.  ; If last visit and no next visit, next visit is 100 days from the last visit
  1.  I LASTVSTI?7N.1".".N,NEXTVSTI'?7N.1".".N S NEXTVSTI=$$FMADD^XLFDT(LASTVSTI,100)
  1.  S:LASTVSTI?7N.1".".N LASTVIST=$$FMTE^XLFDT(+(LASTVSTI\1),1)
  1.  S:LASTVIST="" LASTVIST="None Recorded"
  1.  ; If patient is deceased, do not display next visit
  1.  I $G(BKMDOD)'="" S NEXTVSTI=""
  1.  S:NEXTVSTI?7N.1".".N NEXTVIST=$$FMTE^XLFDT(+(NEXTVSTI\1),1)
  1.  I 'SCHEDULE,NEXTVIST'?." " S NEXTVIST=NEXTVIST_"*" I NEXTVSTI<DT S NEXTVIST=NEXTVIST_"*"
  1.  ;S STAT=$P(^BKM(90451,BKMIEN,1,BKMREG,0),U,7)
  1.  S STAT=$$GET1^DIQ(90451.01,BKMIENS,".5","E")
  1.  ;S STAT=$S(STAT="A":"ACTIVE",STAT="I":"INACTIVE",STAT="D":"DECEASED",STAT="T":"TRANSIENT",STAT="R":"UNREVIEWED",STAT="N":"NOT ACCEPTED",1:"**")
  1.  ;
  1.  S REM=""
  1.  I $G(CALCREM) D
  1.  . W !,!,"Calculating Reminders.. This may take a moment.",! H 3
  1.  . D REMIND^BKMVF3(DFN,DT,.REMLIST)
  1.  . K CALCREM
  1.  I $D(REMLIST)>1 S REM="Overdue Reminders for this Patient",^TMP("BKMVA2R",$J,DFN,"REM")=REM
  1.  ;
  1.  S OPIA=""
  1.  D GETALL^BKMVC6(DFN)  ; Opportunistic infections or AIDS
  1.  I $D(ICD9S)>1 S OPIA="Opportunistic Infection or AIDS Defining Illness Present"
  1.  ;
  1.  D UPDETI
  1.  ;
  1.  S ALLERGY=$O(^GMR(120.86,"B",DFN,""))
  1.  I ALLERGY'="" S ALLERGY=$$GET1^DIQ(120.86,ALLERGY,1,"I")
  1.  ;
  1.  S INITHIV=$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMIENS,"5","I"),1)
  1.  S INITAIDS=$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMIENS,"5.5","I"),1)
  1.  ;
  1.  S PCPROV=$$PRIMPROV^BKMVA1(DFN) ; Provider
  1.  ; 
  1.  S HIVPROV=$$GET1^DIQ(90451.01,BKMIENS,6,"E") ; HIV Provider
  1.  S HIVCMGR=$$GET1^DIQ(90451.01,BKMIENS,6.5,"E") ; HIV Case Manager
  1.  I '$F("AH",DGCTI) D  ;If at risk set clinical classn, HIV and AIDS dxs to N/A
  1.  . S (CLCL,INITHIV,INITAIDS)="N/A"
  1.  I DGCTI="H" S INITAIDS="N/A" ;If HIV set initial AIDS to N/A
  1.  Q 1
  1. UPDETI ;
  1.  N ET
  1.  S ET=$$GET1^DIQ(90451.01,BKMIENS,"7","E")
  1.  S ACRF=""
  1.  S:ET="" ACRF="Add CDC Etiology Category"
  1.  Q
  1.  ;
  1. EXIT ;
  1.  Q
  1. HDR ;
  1.  Q
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !
  1.  Q
  1. LSTVST(BKMDFN) ; Determine last visit
  1.  N LSTVST,RVSTDT,LSTVSTI,BKMSVCAT
  1.  S (LSTVST,RVSTDT,LSTVSTI)=""
  1.  F  S RVSTDT=$O(^AUPNVSIT("AA",BKMDFN,RVSTDT)) Q:RVSTDT=""  D  Q:LSTVST'=""
  1.  .S LSTVSTI=""
  1.  .F  S LSTVSTI=$O(^AUPNVSIT("AA",BKMDFN,RVSTDT,LSTVSTI)) Q:LSTVSTI=""  D
  1.  ..; Filter based on service category - exclude:
  1.  ..; E (historical), C (chart review), T (telecomm), N (not found),
  1.  ..; D (daily hosp), I (in hosp) and X (ancill pkg)
  1.  ..S BKMSVCAT=$$GET1^DIQ(9000010,LSTVSTI_",",".07","I")
  1.  ..I "^E^C^T^N^D^I^X^"[(U_BKMSVCAT_U) Q
  1.  ..; Filter if visit does not have a POV
  1.  ..I '$D(^AUPNVPOV("AD",LSTVSTI)) Q
  1.  ..S LSTVST=$$GET1^DIQ(9000010,LSTVSTI_",",".01","I")
  1.  Q LSTVST
  1.  ;
  1.  ;