BIPATPF ;IHS/CMI/MWR - VIEW PATIENT PROFILE; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; DISPLAY PATIENT'S IMMUNIZATION IMM/SERVE PROFILE.
;
;
;----------
START ;EP
;---> Lookup patients and display their Immunization Profiles.
;---> NOT CALLED BY ANY MENU OPTION AT THIS TIME.
D SETVARS^BIUTL5 N BIDFN
F D Q:$G(BIDFN)<1
.D TITLE^BIUTL5("PATIENT IMMUNIZATION PROFILE")
.D PATLKUP^BIUTL8(.BIDFN)
.Q:$G(BIDFN)<1
.D EN(BIDFN)
D EXIT
Q
;
;
;----------
HAVEPAT(BIDFN,BIFDT,BIDUZ2) ;EP
;---> Entry point when patient already known.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BIFDT (opt) Forecast Date (date used for forecast).
; 3 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
; Rules in Patient History data string.
;
;---> Check for BIDFN.
Q:$$DFNCHECK^BIUTL2()
;---> If no Forecast Date passed, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;---> If no Site passed, set equal to user's site.
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
;
D SETVARS^BIUTL5
K ^BITMP($J),^TMP("BILMPF",$J)
S ^BITMP($J,1,BIDFN)=""
D EN(BIDFN,BIFDT,BIDUZ2)
D EXIT
Q
;
;
;----------
EN(BIDFN,BIFDT,BIDUZ2) ;EP
;---> Main entry point for BI PATIENT PROFILE VIEW.
I '$G(BIDFN) D EN^DDIOL("No Patient selected.") Q
S:'$G(BIFDT) BIFDT=DT
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
N DFN S DFN=BIDFN ;For now with Linda's view reg templates.
D EN^VALM("BI PATIENT PROFILE VIEW")
Q
;
;
;----------
HDR ;EP
;---> Header code.
Q:'$D(BIDFN)
N BICRT,X,Y
S BICRT=$S(($E($G(IOST))="C")!(IOST["BROWSER"):1,1:0)
S VALMHDR(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)
S:BICRT X=X_IOINORM
S VALMHDR(2)=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(20-$L(Y))_$$ACTIVE^BIUTL1(BIDFN)
S X=X_" "_$$SEXW^BIUTL1(BIDFN)
S VALMHDR(3)=X
;
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
;---> If BIDFN not supplied, set Error Code and quit.
I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q
;
;---> Initialize RPC variables.
; BI31 - Delimiter between return value and return error.
; BIRETVAL - Return value of valid data from RPC.
; BIRETERR - Return value (text string) of error from RPC.
N BI30,BI31,BIRETVAL,BIRETERR
S BI30=$C(30),BI31=$C(31)_$C(31),BIRETVAL=""
;
;---> RPC to gather Immunization History.
D IMMPROF^BIRPC(.BIRETVAL,BIDFN,$G(BIFDT),$G(BIDUZ2))
;
;---> Set BIGBL=to global where Immserve Profile is stored
;---> (returned from RPC).
N BIGBL S BIGBL=$P($P(BIRETVAL,BI31,1),")")_","
;---> BIGBL is ^BITEMP($J,"PROF",
;
;---> If error was returned in ^BITEMP($J,"PROF",1),
;---> set BIRETERR=error text, display it and quit.
S BIRETERR=$P(@(BIGBL_1_")"),BI31,2)
I BIRETERR]"" D Q
.D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3()
.S VALMQUIT=""
;
;---> Build Listmanager array from BIGBL global array.
K ^TMP("BILMPF",$J)
N BILINE,N S N=0
F S N=$O(@(BIGBL_N_")")) Q:'N D
.S ^TMP("BILMPF",$J,N,0)=" "_$P(@(BIGBL_N_")"),BI30)
.S BILINE=N
;
;---> Overwrite BI31 node and set final VALM line count.
S ^TMP("BILMPF",$J,BILINE,0)=" "
S VALMCNT=BILINE
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 FULL^VALM1
W !!?5,"Use arrow keys to scroll up and down through the report, or"
W !?5,"type ""??"" for more actions, such as Search and Print List."
D DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
D:BIX'="??" RE^VALM4
Q
;
;
;----------
EXIT ;EP
;---> EOJ Cleanup.
K ^TMP("BILMPF",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
BIPATPF ;IHS/CMI/MWR - VIEW PATIENT PROFILE; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; DISPLAY PATIENT'S IMMUNIZATION IMM/SERVE PROFILE.
+4 ;
+5 ;
+6 ;----------
START ;EP
+1 ;---> Lookup patients and display their Immunization Profiles.
+2 ;---> NOT CALLED BY ANY MENU OPTION AT THIS TIME.
+3 DO SETVARS^BIUTL5
NEW BIDFN
+4 FOR
Begin DoDot:1
+5 DO TITLE^BIUTL5("PATIENT IMMUNIZATION PROFILE")
+6 DO PATLKUP^BIUTL8(.BIDFN)
+7 IF $GET(BIDFN)<1
QUIT
+8 DO EN(BIDFN)
End DoDot:1
IF $GET(BIDFN)<1
QUIT
+9 DO EXIT
+10 QUIT
+11 ;
+12 ;
+13 ;----------
HAVEPAT(BIDFN,BIFDT,BIDUZ2) ;EP
+1 ;---> Entry point when patient already known.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BIFDT (opt) Forecast Date (date used for forecast).
+5 ; 3 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
+6 ; Rules in Patient History data string.
+7 ;
+8 ;---> Check for BIDFN.
+9 IF $$DFNCHECK^BIUTL2()
QUIT
+10 ;---> If no Forecast Date passed, set it equal to today.
+11 IF '$GET(BIFDT)
SET BIFDT=DT
+12 ;---> If no Site passed, set equal to user's site.
+13 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+14 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(105,,1)
QUIT
+15 ;
+16 DO SETVARS^BIUTL5
+17 KILL ^BITMP($JOB),^TMP("BILMPF",$JOB)
+18 SET ^BITMP($JOB,1,BIDFN)=""
+19 DO EN(BIDFN,BIFDT,BIDUZ2)
+20 DO EXIT
+21 QUIT
+22 ;
+23 ;
+24 ;----------
EN(BIDFN,BIFDT,BIDUZ2) ;EP
+1 ;---> Main entry point for BI PATIENT PROFILE VIEW.
+2 IF '$GET(BIDFN)
DO EN^DDIOL("No Patient selected.")
QUIT
+3 IF '$GET(BIFDT)
SET BIFDT=DT
+4 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+5 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(105,,1)
QUIT
+6 ;For now with Linda's view reg templates.
NEW DFN
SET DFN=BIDFN
+7 DO EN^VALM("BI PATIENT PROFILE VIEW")
+8 QUIT
+9 ;
+10 ;
+11 ;----------
HDR ;EP
+1 ;---> Header code.
+2 IF '$DATA(BIDFN)
QUIT
+3 NEW BICRT,X,Y
+4 SET BICRT=$SELECT(($EXTRACT($GET(IOST))="C")!(IOST["BROWSER"):1,1:0)
+5 SET VALMHDR(1)=""
+6 SET Y=$EXTRACT($$NAME^BIUTL1(BIDFN),1,25)
+7 SET X=" Patient: "
+8 IF BICRT
SET X=X_IORVON
+9 SET X=X_Y
+10 IF BICRT
SET X=X_IOINORM
+11 SET X=X_$$SP^BIUTL5(27-$LENGTH(Y))_"DOB: "
+12 IF BICRT
SET X=X_IORVON
+13 SET X=X_$$DOBF^BIUTL1(BIDFN)
+14 IF BICRT
SET X=X_IOINORM
+15 SET VALMHDR(2)=X
+16 SET X=" Chart#: "
+17 IF BICRT
SET X=X_IORVON
+18 SET X=X_$$HRCN^BIUTL1(BIDFN)
+19 SET Y=$EXTRACT($$INSTTX^BIUTL6($GET(DUZ(2))),1,17)
+20 SET X=X_" at "_Y
+21 IF BICRT
SET X=X_IOINORM
+22 SET X=X_$$SP^BIUTL5(20-$LENGTH(Y))_$$ACTIVE^BIUTL1(BIDFN)
+23 SET X=X_" "_$$SEXW^BIUTL1(BIDFN)
+24 SET VALMHDR(3)=X
+25 ;
+26 QUIT
+27 ;
+28 ;
+29 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;
+3 ;---> If BIDFN not supplied, set Error Code and quit.
+4 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,,1)
QUIT
+5 ;
+6 ;---> Initialize RPC variables.
+7 ; BI31 - Delimiter between return value and return error.
+8 ; BIRETVAL - Return value of valid data from RPC.
+9 ; BIRETERR - Return value (text string) of error from RPC.
+10 NEW BI30,BI31,BIRETVAL,BIRETERR
+11 SET BI30=$CHAR(30)
SET BI31=$CHAR(31)_$CHAR(31)
SET BIRETVAL=""
+12 ;
+13 ;---> RPC to gather Immunization History.
+14 DO IMMPROF^BIRPC(.BIRETVAL,BIDFN,$GET(BIFDT),$GET(BIDUZ2))
+15 ;
+16 ;---> Set BIGBL=to global where Immserve Profile is stored
+17 ;---> (returned from RPC).
+18 NEW BIGBL
SET BIGBL=$PIECE($PIECE(BIRETVAL,BI31,1),")")_","
+19 ;---> BIGBL is ^BITEMP($J,"PROF",
+20 ;
+21 ;---> If error was returned in ^BITEMP($J,"PROF",1),
+22 ;---> set BIRETERR=error text, display it and quit.
+23 SET BIRETERR=$PIECE(@(BIGBL_1_")"),BI31,2)
+24 IF BIRETERR]""
Begin DoDot:1
+25 DO EN^DDIOL("* "_BIRETERR,"","!!?5")
DO DIRZ^BIUTL3()
+26 SET VALMQUIT=""
End DoDot:1
QUIT
+27 ;
+28 ;---> Build Listmanager array from BIGBL global array.
+29 KILL ^TMP("BILMPF",$JOB)
+30 NEW BILINE,N
SET N=0
+31 FOR
SET N=$ORDER(@(BIGBL_N_")"))
IF 'N
QUIT
Begin DoDot:1
+32 SET ^TMP("BILMPF",$JOB,N,0)=" "_$PIECE(@(BIGBL_N_")"),BI30)
+33 SET BILINE=N
End DoDot:1
+34 ;
+35 ;---> Overwrite BI31 node and set final VALM line count.
+36 SET ^TMP("BILMPF",$JOB,BILINE,0)=" "
+37 SET VALMCNT=BILINE
+38 QUIT
+39 ;
+40 ;
+41 ;----------
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 FULL^VALM1
+4 WRITE !!?5,"Use arrow keys to scroll up and down through the report, or"
+5 WRITE !?5,"type ""??"" for more actions, such as Search and Print List."
+6 DO DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
+7 IF BIX'="??"
DO RE^VALM4
+8 QUIT
+9 ;
+10 ;
+11 ;----------
EXIT ;EP
+1 ;---> EOJ Cleanup.
+2 KILL ^TMP("BILMPF",$JOB)
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 QUIT
