BIPATVW ;IHS/CMI/MWR - VIEW PATIENT IMM DATA; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW PATIENT'S IMMUNIZATION DATA AND ALLOW EDITS
;; THROUGH LISTMANAGER.
;
;
;----------
START ;EP
;---> Lookup patients, view and edit their Immunization data.
;
D SETVARS^BIUTL5 N BIDFN,BIFDT,BIPOP,BIRTN
F D Q:$G(BIDFN)<1
.D TITLE^BIUTL5("VIEW PATIENT IMMUNIZATION DATA")
.D PATLKUP^BIUTL8(.BIDFN,$S($$MAYEDIT^BIUTL11:"ADD",1:""),DUZ(2),.BIPOP)
.Q:$G(BIPOP) Q:$G(BIDFN)<1
.D DATE(.BIFDT,.BIPOP)
.Q:BIPOP
.D EN(BIDFN,$$MAYEDIT^BIUTL11,BIFDT,DUZ(2))
.D UNLOCK($G(BIDFN))
D EXIT
Q
;
;
;----------
ONEPAT ;EP
;---> Lookup patients, view and edit their Immunization data.
;
D SETVARS^BIUTL5 N BIDFN,BIFDT,BIPOP,BIRTN
D
.D PATLKUP^BIUTL8(.BIDFN,$S($$MAYEDIT^BIUTL11:"ADD",1:""),DUZ(2),.BIPOP)
.Q:$G(BIPOP) Q:$G(BIDFN)<1
.D DATE(.BIFDT,.BIPOP)
.Q:BIPOP
.D EN(BIDFN,$$MAYEDIT^BIUTL11,BIFDT,DUZ(2))
.D UNLOCK($G(BIDFN))
D EXIT
Q
;
;
;----------
HAVEPAT(BIDFN,BIFDT,BIPRT,BIPOP) ;EP
;---> Entry point when patient is already known.
;---> Parameters:
; 1 - BIDFN (req) Patient IEN.
; 2 - BIFDT (opt) Forecast Date (date used for forecast).
; 3 - BIPRT (opt) If BIPRT=1 this call is to print.
; 4 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
;
D SETVARS^BIUTL5 S BIPOP=0 N BIN ;(Preserve BIN from calls above.)
I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) S BIPOP=1 Q
I '$D(^AUPNPAT(BIDFN)) D ERRCD^BIUTL2(203,,1) S BIPOP=1 Q
K ^BITMP($J),^TMP("BILMVW",$J)
S ^BITMP($J,1,BIDFN)=""
D:'$G(BIFDT) DATE(.BIFDT,.BIPOP)
Q:BIPOP
D EN(BIDFN,$S($G(BIPRT):2,1:$$MAYEDIT^BIUTL11),$G(BIFDT),DUZ(2))
Q
;
;
;----------
EN(BIDFN,BIEDIT,BIFDT,BIDUZ2) ;EP
;---> Main entry point to call Lists: BI PATIENT DATA VIEW/EDIT
;---> and BI PATIENT VIEW ONLY.
;---> Parameters:
; 1 - BIDFN (req) Patient IEN.
; 2 - BIEDIT (opt) Null or 0=View only; 1=View/Edit, 2=Print.
; 3 - BIFDT (opt) Forecast Date (date used for forecast).
; 4 - BIDUZ2 (req) User's DUZ(2) for BISITE parameters,
; which affect forecasting rules.
;
I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
;
;---> If no Forecast Date passed, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;
;---> BIHX contains the patient's Immunization History and is
;---> used by various protocols and actions in Listmanager.
N BIHX,DFN S DFN=BIDFN ;For now with Linda's view reg templates.
;
;---> Print Patient Data and quit.
;---> (Called by Protocol BI PATIENT VIEW PRINT.)
I $G(BIEDIT)=2 D PRINT Q
;
;---> Select List Template to View/Edit or View Only.
S BILIST="BI PATIENT DATA VIEW"_$S($G(BIEDIT)=1:"/EDIT",1:" ONLY")
I '$D(^SD(409.61,"B",BILIST)) D ERRCD^BIUTL2(628,,1) Q
D EN^VALM(BILIST)
Q
;
;
;----------
PRINT ;EP
;---> Print Patient Data screen.
;---> Called by Protocol BI PATIENT VIEW PRINT, which is the
;---> Print List Protocol for Lists: BI PATIENT DATA VIEW/EDIT and
;---> BI PATIENT DATA VIEW ONLY.
;
D DEVICE(.BIPOP)
I $G(BIPOP) D RESET Q
;
D HDR(1),MAIN^BIPATVW1(1)
D PRTLST^BIUTL8("BILMVW")
D RESET
Q
;
;
;----------
HDR(BIPRT) ;EP
;---> Header code for both Listman Screen and Print List.
;---> Parameters:
; 1 - BIPRT (opt) If BIPRT=1 array is for print: Add Privacy Act
; line and Site Header line.
;
N BILINE,X,Y S BILINE=0 K VALMHDR
N BICRT S BICRT=$S(($E($G(IOST))="C")!(IOST["BROWSER"):1,1:0)
;
D WH^BIW(.BILINE)
;
D:$G(BIPRT)
.S X="WARNING: Confidential Patient Information, Privacy Act applies."
.D WH^BIW(.BILINE," "_X,1)
.;
.S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)
.D WH^BIW(.BILINE,X)
.S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
.D WH^BIW(.BILINE,X,1)
;
S Y=$E($$NAME^BIUTL1(BIDFN),1,25)
S X=" Patient: "
S:BICRT X=X_IORVON
S X=X_Y
S:BICRT X=X_IOINORM
S X=X_$$SP^BIUTL5(27-$L(Y))_"DOB: "
S:BICRT X=X_IORVON
S X=X_$$DOBF^BIUTL1(BIDFN,$G(BIFDT))
S:BICRT X=X_IOINORM
D WH^BIW(.BILINE,X)
S X=" Chart#: "
S:BICRT X=X_IORVON
S X=X_$$HRCN^BIUTL1(BIDFN)
S Y=$E($$INSTTX^BIUTL6($G(DUZ(2))),1,17)
S X=X_" at "_Y
S:BICRT X=X_IOINORM
S X=X_$$SP^BIUTL5(49-$L(X))_$$ACTIVE^BIUTL1(BIDFN)
S X=X_" "_$$SEXW^BIUTL1(BIDFN)
D:$D(^BIP(BIDFN,0))
.S X=X_" "_"M HBsAg: "_$E($$MOTHER^BIUTL11(BIDFN,1),1,3)
D WH^BIW(.BILINE,X,1)
D:$G(BIPRT)
.S X=" # Immunization History | Immunizations DUE"
.S:$G(BIFDT) X=X_" on "_$$SLDT2^BIUTL5(BIFDT)
.D WH^BIW(.BILINE,X)
;
;---> Set Screen Title.
S VALM("TITLE")="PATIENT VIEW (IMM v"_$$VER^BILOGO_")"
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
D MAIN^BIPATVW1()
S BIRTN="BIPATVW"
Q
;
;
;----------
DATE(BIFDT,BIPOP) ;EP
;---> Ask Forecast Date.
;---> Parameters:
; 1 - BIFDT (ret) Forecast Date, Fileman format.
; (opt) Default Date.
; 2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
;
N BIDFLT,DIR
DATE1 ;EP
S BIPOP=0
S:$G(BIFDT)="" BIFDT=DT
S BIDFLT=$$TXDT^BIUTL5(BIFDT)
D HELP1
S DIR(0)="DA^::EX"
S DIR("A")=" Select Forecast Date: ",DIR("B")=BIDFLT
D ^DIR W !
I $D(DIRUT) S BIPOP=1 Q
S BIFDT=$P(Y,".")
I BIFDT<$$DOB^BIUTL1(BIDFN) D G DATE1
.W !?5,"Date must be after patient's date of birth."
.K BIFDT D DIRZ^BIUTL3()
Q
;
;
;----------
HELP1 ;EP
;;The "Forecast" is a list of immunizations that a patient is due
;;to receive.
;;
;;You may view the immunizations that this patient WOULD BE due for
;;on a date other than today (past or future).
D HELPTX("HELP1")
Q
;
;
;----------
HELPTX(BILINL,BITAB) ;EP
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT,HDR() Q
;
;
;----------
HELP ;EP
;---> Help code.
N BIX S BIX=X
D EN^XBNEW("HELP^BIPATVW3","VALM*;IO*")
D:BIX'="??" RE^VALM4
Q
;
;
;----------
EXIT ;EP
;---> EOJ Cleanup.
D KILLALL^BIUTL8(1)
K ^TMP("BILMVW",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
;
;
;----------
DEVICE(BIPOP) ;EP
;---> Get Device and possibly queue to Taskman.
;---> Parameters:
; 1 - BIPOP (ret) If error or Queue, BIPOP=1
;
K %ZIS,IOP S BIPOP=0
S ZTRTN="DEQUEUE^BIPATVW"
D ZSAVES^BIUTL3
D ZIS^BIUTL2(.BIPOP,1)
Q
;
;
;----------
DEQUEUE ;EP
;---> Print Patient Data screen.
D HDR(1),MAIN^BIPATVW1(1)
D PRTLST^BIUTL8("BILMVW"),EXIT
Q
;
;
;----------
UNLOCK(BIDFN) ;EP
;---> Unlock BI PATIENT global for this patient.
;---> Parameters:
; 1 - BIDFN (req) Patient DFN to unlock.
;
Q:'$G(BIDFN)
N I F I=1:1:5 L -^BIP(BIDFN)
Q
;
;
;----------
PRINTX(BILINL,BITAB) ;EP
Q:$G(BILINL)=""
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
BIPATVW ;IHS/CMI/MWR - VIEW PATIENT IMM DATA; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW PATIENT'S IMMUNIZATION DATA AND ALLOW EDITS
+4 ;; THROUGH LISTMANAGER.
+5 ;
+6 ;
+7 ;----------
START ;EP
+1 ;---> Lookup patients, view and edit their Immunization data.
+2 ;
+3 DO SETVARS^BIUTL5
NEW BIDFN,BIFDT,BIPOP,BIRTN
+4 FOR
Begin DoDot:1
+5 DO TITLE^BIUTL5("VIEW PATIENT IMMUNIZATION DATA")
+6 DO PATLKUP^BIUTL8(.BIDFN,$SELECT($$MAYEDIT^BIUTL11:"ADD",1:""),DUZ(2),.BIPOP)
+7 IF $GET(BIPOP)
QUIT
IF $GET(BIDFN)<1
QUIT
+8 DO DATE(.BIFDT,.BIPOP)
+9 IF BIPOP
QUIT
+10 DO EN(BIDFN,$$MAYEDIT^BIUTL11,BIFDT,DUZ(2))
+11 DO UNLOCK($GET(BIDFN))
End DoDot:1
IF $GET(BIDFN)<1
QUIT
+12 DO EXIT
+13 QUIT
+14 ;
+15 ;
+16 ;----------
ONEPAT ;EP
+1 ;---> Lookup patients, view and edit their Immunization data.
+2 ;
+3 DO SETVARS^BIUTL5
NEW BIDFN,BIFDT,BIPOP,BIRTN
+4 Begin DoDot:1
+5 DO PATLKUP^BIUTL8(.BIDFN,$SELECT($$MAYEDIT^BIUTL11:"ADD",1:""),DUZ(2),.BIPOP)
+6 IF $GET(BIPOP)
QUIT
IF $GET(BIDFN)<1
QUIT
+7 DO DATE(.BIFDT,.BIPOP)
+8 IF BIPOP
QUIT
+9 DO EN(BIDFN,$$MAYEDIT^BIUTL11,BIFDT,DUZ(2))
+10 DO UNLOCK($GET(BIDFN))
End DoDot:1
+11 DO EXIT
+12 QUIT
+13 ;
+14 ;
+15 ;----------
HAVEPAT(BIDFN,BIFDT,BIPRT,BIPOP) ;EP
+1 ;---> Entry point when patient is already known.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient IEN.
+4 ; 2 - BIFDT (opt) Forecast Date (date used for forecast).
+5 ; 3 - BIPRT (opt) If BIPRT=1 this call is to print.
+6 ; 4 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
+7 ;
+8 ;(Preserve BIN from calls above.)
DO SETVARS^BIUTL5
SET BIPOP=0
NEW BIN
+9 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,,1)
SET BIPOP=1
QUIT
+10 IF '$DATA(^AUPNPAT(BIDFN))
DO ERRCD^BIUTL2(203,,1)
SET BIPOP=1
QUIT
+11 KILL ^BITMP($JOB),^TMP("BILMVW",$JOB)
+12 SET ^BITMP($JOB,1,BIDFN)=""
+13 IF '$GET(BIFDT)
DO DATE(.BIFDT,.BIPOP)
+14 IF BIPOP
QUIT
+15 DO EN(BIDFN,$SELECT($GET(BIPRT):2,1:$$MAYEDIT^BIUTL11),$GET(BIFDT),DUZ(2))
+16 QUIT
+17 ;
+18 ;
+19 ;----------
EN(BIDFN,BIEDIT,BIFDT,BIDUZ2) ;EP
+1 ;---> Main entry point to call Lists: BI PATIENT DATA VIEW/EDIT
+2 ;---> and BI PATIENT VIEW ONLY.
+3 ;---> Parameters:
+4 ; 1 - BIDFN (req) Patient IEN.
+5 ; 2 - BIEDIT (opt) Null or 0=View only; 1=View/Edit, 2=Print.
+6 ; 3 - BIFDT (opt) Forecast Date (date used for forecast).
+7 ; 4 - BIDUZ2 (req) User's DUZ(2) for BISITE parameters,
+8 ; which affect forecasting rules.
+9 ;
+10 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,,1)
QUIT
+11 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+12 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(105,,1)
QUIT
+13 ;
+14 ;---> If no Forecast Date passed, set it equal to today.
+15 IF '$GET(BIFDT)
SET BIFDT=DT
+16 ;
+17 ;---> BIHX contains the patient's Immunization History and is
+18 ;---> used by various protocols and actions in Listmanager.
+19 ;For now with Linda's view reg templates.
NEW BIHX,DFN
SET DFN=BIDFN
+20 ;
+21 ;---> Print Patient Data and quit.
+22 ;---> (Called by Protocol BI PATIENT VIEW PRINT.)
+23 IF $GET(BIEDIT)=2
DO PRINT
QUIT
+24 ;
+25 ;---> Select List Template to View/Edit or View Only.
+26 SET BILIST="BI PATIENT DATA VIEW"_$SELECT($GET(BIEDIT)=1:"/EDIT",1:" ONLY")
+27 IF '$DATA(^SD(409.61,"B",BILIST))
DO ERRCD^BIUTL2(628,,1)
QUIT
+28 DO EN^VALM(BILIST)
+29 QUIT
+30 ;
+31 ;
+32 ;----------
PRINT ;EP
+1 ;---> Print Patient Data screen.
+2 ;---> Called by Protocol BI PATIENT VIEW PRINT, which is the
+3 ;---> Print List Protocol for Lists: BI PATIENT DATA VIEW/EDIT and
+4 ;---> BI PATIENT DATA VIEW ONLY.
+5 ;
+6 DO DEVICE(.BIPOP)
+7 IF $GET(BIPOP)
DO RESET
QUIT
+8 ;
+9 DO HDR(1)
DO MAIN^BIPATVW1(1)
+10 DO PRTLST^BIUTL8("BILMVW")
+11 DO RESET
+12 QUIT
+13 ;
+14 ;
+15 ;----------
HDR(BIPRT) ;EP
+1 ;---> Header code for both Listman Screen and Print List.
+2 ;---> Parameters:
+3 ; 1 - BIPRT (opt) If BIPRT=1 array is for print: Add Privacy Act
+4 ; line and Site Header line.
+5 ;
+6 NEW BILINE,X,Y
SET BILINE=0
KILL VALMHDR
+7 NEW BICRT
SET BICRT=$SELECT(($EXTRACT($GET(IOST))="C")!(IOST["BROWSER"):1,1:0)
+8 ;
+9 DO WH^BIW(.BILINE)
+10 ;
+11 IF $GET(BIPRT)
Begin DoDot:1
+12 SET X="WARNING: Confidential Patient Information, Privacy Act applies."
+13 DO WH^BIW(.BILINE," "_X,1)
+14 ;
+15 SET X=$$REPHDR^BIUTL6(DUZ(2))
SET BIDASH=$LENGTH(X)+2
DO CENTERT^BIUTL5(.X)
+16 DO WH^BIW(.BILINE,X)
+17 SET X=$$SP^BIUTL5(BIDASH,"-")
DO CENTERT^BIUTL5(.X)
+18 DO WH^BIW(.BILINE,X,1)
End DoDot:1
+19 ;
+20 SET Y=$EXTRACT($$NAME^BIUTL1(BIDFN),1,25)
+21 SET X=" Patient: "
+22 IF BICRT
SET X=X_IORVON
+23 SET X=X_Y
+24 IF BICRT
SET X=X_IOINORM
+25 SET X=X_$$SP^BIUTL5(27-$LENGTH(Y))_"DOB: "
+26 IF BICRT
SET X=X_IORVON
+27 SET X=X_$$DOBF^BIUTL1(BIDFN,$GET(BIFDT))
+28 IF BICRT
SET X=X_IOINORM
+29 DO WH^BIW(.BILINE,X)
+30 SET X=" Chart#: "
+31 IF BICRT
SET X=X_IORVON
+32 SET X=X_$$HRCN^BIUTL1(BIDFN)
+33 SET Y=$EXTRACT($$INSTTX^BIUTL6($GET(DUZ(2))),1,17)
+34 SET X=X_" at "_Y
+35 IF BICRT
SET X=X_IOINORM
+36 SET X=X_$$SP^BIUTL5(49-$LENGTH(X))_$$ACTIVE^BIUTL1(BIDFN)
+37 SET X=X_" "_$$SEXW^BIUTL1(BIDFN)
+38 IF $DATA(^BIP(BIDFN,0))
Begin DoDot:1
+39 SET X=X_" "_"M HBsAg: "_$EXTRACT($$MOTHER^BIUTL11(BIDFN,1),1,3)
End DoDot:1
+40 DO WH^BIW(.BILINE,X,1)
+41 IF $GET(BIPRT)
Begin DoDot:1
+42 SET X=" # Immunization History | Immunizations DUE"
+43 IF $GET(BIFDT)
SET X=X_" on "_$$SLDT2^BIUTL5(BIFDT)
+44 DO WH^BIW(.BILINE,X)
End DoDot:1
+45 ;
+46 ;---> Set Screen Title.
+47 SET VALM("TITLE")="PATIENT VIEW (IMM v"_$$VER^BILOGO_")"
+48 QUIT
+49 ;
+50 ;
+51 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 DO MAIN^BIPATVW1()
+3 SET BIRTN="BIPATVW"
+4 QUIT
+5 ;
+6 ;
+7 ;----------
DATE(BIFDT,BIPOP) ;EP
+1 ;---> Ask Forecast Date.
+2 ;---> Parameters:
+3 ; 1 - BIFDT (ret) Forecast Date, Fileman format.
+4 ; (opt) Default Date.
+5 ; 2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
+6 ;
+7 NEW BIDFLT,DIR
DATE1 ;EP
+1 SET BIPOP=0
+2 IF $GET(BIFDT)=""
SET BIFDT=DT
+3 SET BIDFLT=$$TXDT^BIUTL5(BIFDT)
+4 DO HELP1
+5 SET DIR(0)="DA^::EX"
+6 SET DIR("A")=" Select Forecast Date: "
SET DIR("B")=BIDFLT
+7 DO ^DIR
WRITE !
+8 IF $DATA(DIRUT)
SET BIPOP=1
QUIT
+9 SET BIFDT=$PIECE(Y,".")
+10 IF BIFDT<$$DOB^BIUTL1(BIDFN)
Begin DoDot:1
+11 WRITE !?5,"Date must be after patient's date of birth."
+12 KILL BIFDT
DO DIRZ^BIUTL3()
End DoDot:1
GOTO DATE1
+13 QUIT
+14 ;
+15 ;
+16 ;----------
HELP1 ;EP
+1 ;;The "Forecast" is a list of immunizations that a patient is due
+2 ;;to receive.
+3 ;;
+4 ;;You may view the immunizations that this patient WOULD BE due for
+5 ;;on a date other than today (past or future).
+6 DO HELPTX("HELP1")
+7 QUIT
+8 ;
+9 ;
+10 ;----------
HELPTX(BILINL,BITAB) ;EP
+1 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
SET DIR("?",I)=T_$PIECE(X,";;",2)
+3 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listmanager.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO INIT
DO HDR()
QUIT
+5 ;
+6 ;
+7 ;----------
HELP ;EP
+1 ;---> Help code.
+2 NEW BIX
SET BIX=X
+3 DO EN^XBNEW("HELP^BIPATVW3","VALM*;IO*")
+4 IF BIX'="??"
DO RE^VALM4
+5 QUIT
+6 ;
+7 ;
+8 ;----------
EXIT ;EP
+1 ;---> EOJ Cleanup.
+2 DO KILLALL^BIUTL8(1)
+3 KILL ^TMP("BILMVW",$JOB)
+4 DO CLEAR^VALM1
+5 DO FULL^VALM1
+6 QUIT
+7 ;
+8 ;
+9 ;----------
DEVICE(BIPOP) ;EP
+1 ;---> Get Device and possibly queue to Taskman.
+2 ;---> Parameters:
+3 ; 1 - BIPOP (ret) If error or Queue, BIPOP=1
+4 ;
+5 KILL %ZIS,IOP
SET BIPOP=0
+6 SET ZTRTN="DEQUEUE^BIPATVW"
+7 DO ZSAVES^BIUTL3
+8 DO ZIS^BIUTL2(.BIPOP,1)
+9 QUIT
+10 ;
+11 ;
+12 ;----------
DEQUEUE ;EP
+1 ;---> Print Patient Data screen.
+2 DO HDR(1)
DO MAIN^BIPATVW1(1)
+3 DO PRTLST^BIUTL8("BILMVW")
DO EXIT
+4 QUIT
+5 ;
+6 ;
+7 ;----------
UNLOCK(BIDFN) ;EP
+1 ;---> Unlock BI PATIENT global for this patient.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient DFN to unlock.
+4 ;
+5 IF '$GET(BIDFN)
QUIT
+6 NEW I
FOR I=1:1:5
LOCK -^BIP(BIDFN)
+7 QUIT
+8 ;
+9 ;
+10 ;----------
PRINTX(BILINL,BITAB) ;EP
+1 IF $GET(BILINL)=""
QUIT
+2 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+3 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+4 QUIT
