BIKEY ;IHS/CMI/MWR - UTIL: VIEW/ALLOCATE BI KEYS; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW HOLDERS OF BI KEYS AND ALLOCATE/DEALLOCATE KEYS.
;
;
;----------
START ;EP
;---> Main entry point for option BI KEYS ALLOCATE.
D SETVARS^BIUTL5 K ^TMP("BIKEYS",$J) N BITMP,DIR
D EN
D EXIT
Q
;
;
;----------
EN ;EP
D EN^VALM("BI KEY HOLDERS VIEW/EDIT")
Q
;
;
;----------
HDR ;EP
;---> Header code
N BIDASH,BILINE,X,Y S BILINE=0
D WH^BIW(.BILINE)
S X="HOLDERS OF IMMUNIZATION KEYS AT "_$$INSTTX^BIUTL6($G(DUZ(2)))
S 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 X=" HOLDER BIZMENU BIZ EDIT PATIENTS"
S X=X_" BIZ MANAGER BIZ LOT ONLY"
D WH^BIW(.BILINE,X)
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
S VALMSG="Enter ?? for more actions."
S VALM("TITLE")=$$LMVER^BILOGO()
;
K ^TMP("BIHOLD",$J),^TMP("BIKEYS",$J)
N BIKEY S BIKEY="BIZ"
;F S BIKEY=$O(^DIC(19.1,"B",BIKEY)) Q:BIKEY="" Q:BIKEY]"BIZZ" D
F BIKEY="BIZMENU","BIZ EDIT PATIENTS","BIZ MANAGER","BIZ LOT ONLY" D
.N BIKIEN
.S BIKIEN=$O(^DIC(19.1,"B",BIKEY,0))
.Q:'BIKIEN
.;
.N BIDUZ S BIDUZ=0
.F S BIDUZ=$O(^XUSEC(BIKEY,BIDUZ)) Q:BIDUZ="" D
..S ^TMP("BIHOLD",$J,$$PERSON^BIUTL1(BIDUZ),BIKEY)=""
;
;
N BIHLDRS,BINAME S BIHLDRS=0,BINAME=0
F S BINAME=$O(^TMP("BIHOLD",$J,BINAME)) Q:BINAME="" D
.N BIY
.S BIY=" "_$E(BINAME,1,20)
.;
.I $D(^TMP("BIHOLD",$J,BINAME,"BIZMENU")) D
..S BIY=$$PAD^BIUTL5(BIY,24,"."),BIY=BIY_"YES"
.;
.I $D(^TMP("BIHOLD",$J,BINAME,"BIZ EDIT PATIENTS")) D
..S BIY=$$PAD^BIUTL5(BIY,34,"."),BIY=BIY_"YES"
.;
.I $D(^TMP("BIHOLD",$J,BINAME,"BIZ MANAGER")) D
..S BIY=$$PAD^BIUTL5(BIY,54,"."),BIY=BIY_"YES"
.;
.; vvv83
.I $D(^TMP("BIHOLD",$J,BINAME,"BIZ LOT ONLY")) D
..S BIY=$$PAD^BIUTL5(BIY,68,"."),BIY=BIY_"YES"
.;
.S BIHLDRS=BIHLDRS+1
.S ^TMP("BIKEYS",$J,BIHLDRS,0)=BIY
;
S VALMCNT=BIHLDRS
I VALMCNT>13 D
.S VALMSG="Scroll down to view more. Type ?? for more actions."
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
D TITLE^BIUTL5("HOLDERS OF IMMUNIZATION KEYS - HELP")
D TEXT1,DIRZ^BIUTL3()
D:BIX'="??" RE^VALM4
Q
;
;
;----------
TEXT1 ;EP
;;This screen displays all users who hold any of the four Keys to
;;the Immunization Package. The Keys, which begin with BIZ, are
;;listed as column headers at the top of the screen.
;;
;;A "YES" in the column under a Key name indicates that the user
;;listed on that line holds the Key in the column header.
;;
;;There are two Actions presented at the bottom of the screen:
;;
;;1 - "Add/Edit a Holder" allows you to allocate or deallocate the
;; Immunization Keys to users.
;;
;;2 - "Help" presents a detailed explanation of the privileges each Key
;; bestows upon holders of the Key.
;;
;;
;
D PRINTX("TEXT1")
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
;
;
;----------
EXIT ;EP
;---> EOJ cleanup.
K ^TMP("BIHOLD",$J),^TMP("BIKEYS",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
BIKEY ;IHS/CMI/MWR - UTIL: VIEW/ALLOCATE BI KEYS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW HOLDERS OF BI KEYS AND ALLOCATE/DEALLOCATE KEYS.
+4 ;
+5 ;
+6 ;----------
START ;EP
+1 ;---> Main entry point for option BI KEYS ALLOCATE.
+2 DO SETVARS^BIUTL5
KILL ^TMP("BIKEYS",$JOB)
NEW BITMP,DIR
+3 DO EN
+4 DO EXIT
+5 QUIT
+6 ;
+7 ;
+8 ;----------
EN ;EP
+1 DO EN^VALM("BI KEY HOLDERS VIEW/EDIT")
+2 QUIT
+3 ;
+4 ;
+5 ;----------
HDR ;EP
+1 ;---> Header code
+2 NEW BIDASH,BILINE,X,Y
SET BILINE=0
+3 DO WH^BIW(.BILINE)
+4 SET X="HOLDERS OF IMMUNIZATION KEYS AT "_$$INSTTX^BIUTL6($GET(DUZ(2)))
+5 SET BIDASH=$LENGTH(X)+2
DO CENTERT^BIUTL5(.X)
+6 DO WH^BIW(.BILINE,X)
+7 SET X=$$SP^BIUTL5(BIDASH,"-")
DO CENTERT^BIUTL5(.X)
+8 DO WH^BIW(.BILINE,X,1)
+9 SET X=" HOLDER BIZMENU BIZ EDIT PATIENTS"
+10 SET X=X_" BIZ MANAGER BIZ LOT ONLY"
+11 DO WH^BIW(.BILINE,X)
+12 QUIT
+13 ;
+14 ;
+15 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;
+3 SET VALMSG="Enter ?? for more actions."
+4 SET VALM("TITLE")=$$LMVER^BILOGO()
+5 ;
+6 KILL ^TMP("BIHOLD",$JOB),^TMP("BIKEYS",$JOB)
+7 NEW BIKEY
SET BIKEY="BIZ"
+8 ;F S BIKEY=$O(^DIC(19.1,"B",BIKEY)) Q:BIKEY="" Q:BIKEY]"BIZZ" D
+9 FOR BIKEY="BIZMENU","BIZ EDIT PATIENTS","BIZ MANAGER","BIZ LOT ONLY"
Begin DoDot:1
+10 NEW BIKIEN
+11 SET BIKIEN=$ORDER(^DIC(19.1,"B",BIKEY,0))
+12 IF 'BIKIEN
QUIT
+13 ;
+14 NEW BIDUZ
SET BIDUZ=0
+15 FOR
SET BIDUZ=$ORDER(^XUSEC(BIKEY,BIDUZ))
IF BIDUZ=""
QUIT
Begin DoDot:2
+16 SET ^TMP("BIHOLD",$JOB,$$PERSON^BIUTL1(BIDUZ),BIKEY)=""
End DoDot:2
End DoDot:1
+17 ;
+18 ;
+19 NEW BIHLDRS,BINAME
SET BIHLDRS=0
SET BINAME=0
+20 FOR
SET BINAME=$ORDER(^TMP("BIHOLD",$JOB,BINAME))
IF BINAME=""
QUIT
Begin DoDot:1
+21 NEW BIY
+22 SET BIY=" "_$EXTRACT(BINAME,1,20)
+23 ;
+24 IF $DATA(^TMP("BIHOLD",$JOB,BINAME,"BIZMENU"))
Begin DoDot:2
+25 SET BIY=$$PAD^BIUTL5(BIY,24,".")
SET BIY=BIY_"YES"
End DoDot:2
+26 ;
+27 IF $DATA(^TMP("BIHOLD",$JOB,BINAME,"BIZ EDIT PATIENTS"))
Begin DoDot:2
+28 SET BIY=$$PAD^BIUTL5(BIY,34,".")
SET BIY=BIY_"YES"
End DoDot:2
+29 ;
+30 IF $DATA(^TMP("BIHOLD",$JOB,BINAME,"BIZ MANAGER"))
Begin DoDot:2
+31 SET BIY=$$PAD^BIUTL5(BIY,54,".")
SET BIY=BIY_"YES"
End DoDot:2
+32 ;
+33 ; vvv83
+34 IF $DATA(^TMP("BIHOLD",$JOB,BINAME,"BIZ LOT ONLY"))
Begin DoDot:2
+35 SET BIY=$$PAD^BIUTL5(BIY,68,".")
SET BIY=BIY_"YES"
End DoDot:2
+36 ;
+37 SET BIHLDRS=BIHLDRS+1
+38 SET ^TMP("BIKEYS",$JOB,BIHLDRS,0)=BIY
End DoDot:1
+39 ;
+40 SET VALMCNT=BIHLDRS
+41 IF VALMCNT>13
Begin DoDot:1
+42 SET VALMSG="Scroll down to view more. Type ?? for more actions."
End DoDot:1
+43 QUIT
+44 ;
+45 ;
+46 ;----------
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 DO TITLE^BIUTL5("HOLDERS OF IMMUNIZATION KEYS - HELP")
+5 DO TEXT1
DO DIRZ^BIUTL3()
+6 IF BIX'="??"
DO RE^VALM4
+7 QUIT
+8 ;
+9 ;
+10 ;----------
TEXT1 ;EP
+1 ;;This screen displays all users who hold any of the four Keys to
+2 ;;the Immunization Package. The Keys, which begin with BIZ, are
+3 ;;listed as column headers at the top of the screen.
+4 ;;
+5 ;;A "YES" in the column under a Key name indicates that the user
+6 ;;listed on that line holds the Key in the column header.
+7 ;;
+8 ;;There are two Actions presented at the bottom of the screen:
+9 ;;
+10 ;;1 - "Add/Edit a Holder" allows you to allocate or deallocate the
+11 ;; Immunization Keys to users.
+12 ;;
+13 ;;2 - "Help" presents a detailed explanation of the privileges each Key
+14 ;; bestows upon holders of the Key.
+15 ;;
+16 ;;
+17 ;
+18 DO PRINTX("TEXT1")
+19 QUIT
+20 ;
+21 ;
+22 ;----------
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
+5 ;
+6 ;
+7 ;----------
EXIT ;EP
+1 ;---> EOJ cleanup.
+2 KILL ^TMP("BIHOLD",$JOB),^TMP("BIKEYS",$JOB)
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 QUIT
