BIPATCO ;IHS/CMI/MWR - EDIT CONTRAINDICATIONS; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT PATIENT'S CONTRAINDICATIONS THROUGH LISTMANAGER.
;
;
;----------
START ;EP
;---> Lookup patients and Add/Edit their Contraindications.
;---> NOT CALLED BY ANY MENU OPTION AT THIS POINT.
;
D SETVARS^BIUTL5 N BIDFN
F D Q:$G(BIDFN)<1
.D TITLE^BIUTL5("ADD/EDIT CONTRAINDICAIONS")
.D PATLKUP^BIUTL8(.BIDFN)
.Q:$G(BIDFN)<1
.D EN(BIDFN)
D EXIT
Q
;
;
;----------
HAVEPAT(BIDFN) ;EP
;---> Entry point when patient already known.
D SETVARS^BIUTL5
K ^TMP("BILMCO",$J)
D EN(BIDFN)
Q
;
;
;----------
EN(BIDFN) ;EP
;---> Entry point called by Protocol BI CONTRAINDICATIONS.
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
;
;---> If <STKOV> errors appear here, increase STACK in SYSGEN,
;---> System Configuration Parameters.
;
;---> Quit if BIDFN not provided.
I '$G(BIDFN) D ERRCD^BIUTL2(206,,1) Q
;
;---> Quit if this patient is Locked (being edited by another user).
L +^BIP(BIDFN):0 I '$T D ERRCD^BIUTL2(212,,1) Q
N BIDFNSAV S BIDFNSAV=BIDFN
D
.N BIDFNSAV
.D EN^VALM("BI PATIENT CONTRAINDICATIONS")
;
;---> Unlock Patient.
S BIDFN=BIDFNSAV
L -^BIP(BIDFN)
Q
;
;
;----------
HDR ;EP
;---> Header code.
Q:'$D(BIDFN)
N X,Y
S VALMHDR(1)=""
S Y=$E($$NAME^BIUTL1(BIDFN),1,25)
S X=" Patient: "_IORVON_Y_IOINORM
S X=X_$$SP^BIUTL5(27-$L(Y))_"DOB: "_IORVON_$$DOBF^BIUTL1(BIDFN)_IOINORM
S VALMHDR(2)=X
;
S X=" Chart#: "_IORVON_$$HRCN^BIUTL1(BIDFN)
S Y=$E($$INSTTX^BIUTL6($G(DUZ(2))),1,17)
S X=X_" at "_Y_IOINORM
S X=X_$$SP^BIUTL5(20-$L(Y))_$$ACTIVE^BIUTL1(BIDFN)
S X=X_" "_$$SEXW^BIUTL1(BIDFN)
S VALMHDR(3)=X
;
;---> Set Screen Title.
S VALM("TITLE")="CONTRAIND (IMM v"_$$VER^BILOGO_")"
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
D INIT^BIPATCO1
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.
W !!?5,"Enter ""H"" for Help with this feature or ""??"" for more options."
D DIRZ^BIUTL3()
Q
;
;
;----------
HELP1 ;EP
;----> Explanation of this report.
N BITEXT D TEXT1(.BITEXT)
D START^BIHELP("CONTRAINDICATION SCREEN - HELP",.BITEXT)
Q
;
;
;----------
TEXT1(BITEXT) ;EP
;;This is the Patient Contraindication Screen, the point from
;;which you add or delete the patient's contraindications.
;;
;;The TOP of the screen lists the patient's demographic information,
;;most of which is edited through the RPMS Patient Registration.
;;
;;The MIDDLE of the screen lists any Contraindications to vaccines
;;that the patient may have, along with the Reason for the
;;contraindication and the Date it was Noted.
;;
;;The BOTTOM of the screen provides the Actions to Add or Delete
;;Contraindications, or to view this Explanation.
;;
;;Contraindications added for the patient here will cause the
;;contraindicated vaccine to be eliminated from the Forecast
;;(in the right column of the main Patient View screen).
;;
;;HOWEVER, if the Reason chosen for a Contraindication is
;;"Patient Refusal", the vaccine will NOT be eliminated from
;;the Forecast.
;;
;;If you choose "Immune Deficiency," then MMR, Varicella, OPV, and
;;Flu-Nasal (all live vaccines) are automatically contraindicated.
;;
;;NOTE: You may select TST-PPD INTRADERMAL (PPD) as the "vaccine."
;;In this case, the only reason selectable will be "Positive TB Skin Test."
;;This allows the system to display a contraindication to future PPD tests.
;;
D LOADTX("TEXT1",,.BITEXT)
Q
;
;
;----------
LOADTX(BILINL,BITAB,BITEXT) ;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'[";;" S BITEXT(I)=T_$P(X,";;",2)
Q
;
;
;----------
EXIT ;EP
;---> EOJ cleanup.
K ^TMP("BILMCO",$J) D KILLALL^BIUTL8()
D CLEAR^VALM1
D FULL^VALM1
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
BIPATCO ;IHS/CMI/MWR - EDIT CONTRAINDICATIONS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT PATIENT'S CONTRAINDICATIONS THROUGH LISTMANAGER.
+4 ;
+5 ;
+6 ;----------
START ;EP
+1 ;---> Lookup patients and Add/Edit their Contraindications.
+2 ;---> NOT CALLED BY ANY MENU OPTION AT THIS POINT.
+3 ;
+4 DO SETVARS^BIUTL5
NEW BIDFN
+5 FOR
Begin DoDot:1
+6 DO TITLE^BIUTL5("ADD/EDIT CONTRAINDICAIONS")
+7 DO PATLKUP^BIUTL8(.BIDFN)
+8 IF $GET(BIDFN)<1
QUIT
+9 DO EN(BIDFN)
End DoDot:1
IF $GET(BIDFN)<1
QUIT
+10 DO EXIT
+11 QUIT
+12 ;
+13 ;
+14 ;----------
HAVEPAT(BIDFN) ;EP
+1 ;---> Entry point when patient already known.
+2 DO SETVARS^BIUTL5
+3 KILL ^TMP("BILMCO",$JOB)
+4 DO EN(BIDFN)
+5 QUIT
+6 ;
+7 ;
+8 ;----------
EN(BIDFN) ;EP
+1 ;---> Entry point called by Protocol BI CONTRAINDICATIONS.
+2 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+3 ;
+4 ;---> If <STKOV> errors appear here, increase STACK in SYSGEN,
+5 ;---> System Configuration Parameters.
+6 ;
+7 ;---> Quit if BIDFN not provided.
+8 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(206,,1)
QUIT
+9 ;
+10 ;---> Quit if this patient is Locked (being edited by another user).
+11 LOCK +^BIP(BIDFN):0
IF '$TEST
DO ERRCD^BIUTL2(212,,1)
QUIT
+12 NEW BIDFNSAV
SET BIDFNSAV=BIDFN
+13 Begin DoDot:1
+14 NEW BIDFNSAV
+15 DO EN^VALM("BI PATIENT CONTRAINDICATIONS")
End DoDot:1
+16 ;
+17 ;---> Unlock Patient.
+18 SET BIDFN=BIDFNSAV
+19 LOCK -^BIP(BIDFN)
+20 QUIT
+21 ;
+22 ;
+23 ;----------
HDR ;EP
+1 ;---> Header code.
+2 IF '$DATA(BIDFN)
QUIT
+3 NEW X,Y
+4 SET VALMHDR(1)=""
+5 SET Y=$EXTRACT($$NAME^BIUTL1(BIDFN),1,25)
+6 SET X=" Patient: "_IORVON_Y_IOINORM
+7 SET X=X_$$SP^BIUTL5(27-$LENGTH(Y))_"DOB: "_IORVON_$$DOBF^BIUTL1(BIDFN)_IOINORM
+8 SET VALMHDR(2)=X
+9 ;
+10 SET X=" Chart#: "_IORVON_$$HRCN^BIUTL1(BIDFN)
+11 SET Y=$EXTRACT($$INSTTX^BIUTL6($GET(DUZ(2))),1,17)
+12 SET X=X_" at "_Y_IOINORM
+13 SET X=X_$$SP^BIUTL5(20-$LENGTH(Y))_$$ACTIVE^BIUTL1(BIDFN)
+14 SET X=X_" "_$$SEXW^BIUTL1(BIDFN)
+15 SET VALMHDR(3)=X
+16 ;
+17 ;---> Set Screen Title.
+18 SET VALM("TITLE")="CONTRAIND (IMM v"_$$VER^BILOGO_")"
+19 QUIT
+20 ;
+21 ;
+22 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 DO INIT^BIPATCO1
+3 QUIT
+4 ;
+5 ;
+6 ;----------
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 WRITE !!?5,"Enter ""H"" for Help with this feature or ""??"" for more options."
+3 DO DIRZ^BIUTL3()
+4 QUIT
+5 ;
+6 ;
+7 ;----------
HELP1 ;EP
+1 ;----> Explanation of this report.
+2 NEW BITEXT
DO TEXT1(.BITEXT)
+3 DO START^BIHELP("CONTRAINDICATION SCREEN - HELP",.BITEXT)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
TEXT1(BITEXT) ;EP
+1 ;;This is the Patient Contraindication Screen, the point from
+2 ;;which you add or delete the patient's contraindications.
+3 ;;
+4 ;;The TOP of the screen lists the patient's demographic information,
+5 ;;most of which is edited through the RPMS Patient Registration.
+6 ;;
+7 ;;The MIDDLE of the screen lists any Contraindications to vaccines
+8 ;;that the patient may have, along with the Reason for the
+9 ;;contraindication and the Date it was Noted.
+10 ;;
+11 ;;The BOTTOM of the screen provides the Actions to Add or Delete
+12 ;;Contraindications, or to view this Explanation.
+13 ;;
+14 ;;Contraindications added for the patient here will cause the
+15 ;;contraindicated vaccine to be eliminated from the Forecast
+16 ;;(in the right column of the main Patient View screen).
+17 ;;
+18 ;;HOWEVER, if the Reason chosen for a Contraindication is
+19 ;;"Patient Refusal", the vaccine will NOT be eliminated from
+20 ;;the Forecast.
+21 ;;
+22 ;;If you choose "Immune Deficiency," then MMR, Varicella, OPV, and
+23 ;;Flu-Nasal (all live vaccines) are automatically contraindicated.
+24 ;;
+25 ;;NOTE: You may select TST-PPD INTRADERMAL (PPD) as the "vaccine."
+26 ;;In this case, the only reason selectable will be "Positive TB Skin Test."
+27 ;;This allows the system to display a contraindication to future PPD tests.
+28 ;;
+29 DO LOADTX("TEXT1",,.BITEXT)
+30 QUIT
+31 ;
+32 ;
+33 ;----------
LOADTX(BILINL,BITAB,BITEXT) ;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
SET BITEXT(I)=T_$PIECE(X,";;",2)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
EXIT ;EP
+1 ;---> EOJ cleanup.
+2 KILL ^TMP("BILMCO",$JOB)
DO KILLALL^BIUTL8()
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 QUIT
+6 ;
+7 ;
+8 ;----------
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
