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