- 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
