| 1 | PSIVBCID ;BIR/JLC - BAR CODE ID SUBROUTINES ;16 FEB 01
 | 
|---|
| 2 |  ;;5.0; INPATIENT MEDICATIONS ;**58,80,146**;16 DEC 97
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Reference to ^PS(55 supported by DBIA 2191.
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 | BCMA(PSJDFN,PSJON,PSIVCTD,PSIV1,PSIV2,PSIVNOL) ;determine unique ID# for bar code labels and update initial data for bar code ID
 | 
|---|
| 7 |  ;Input:  PSJDFN - patient's DFN
 | 
|---|
| 8 |  ;        PSJON - patient's ON - order number
 | 
|---|
| 9 |  ;        PSJBCID - bar code ID to be filed
 | 
|---|
| 10 |  ;        PSIVCTD - the $D(PSIVCT) from the calling routine, if PSIVCT was defined, then the labels won't be counted
 | 
|---|
| 11 |  ;        PSIV1   - current label number
 | 
|---|
| 12 |  ;        PSIV2   -
 | 
|---|
| 13 |  ;        PSIVNOL - total number of labels
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 |  ;Output:  PSJBCID - unique ID# for this label
 | 
|---|
| 16 |  ;                   format:  DFN_"A"_ON"_seq#
 | 
|---|
| 17 |  ;                   If unable to calculate ID #, return "ERROR"
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 |  S PSIV1=$G(PSIV1),PSIV2=$G(PSIV2),PSIVNOL=$G(PSIVNOL)
 | 
|---|
| 20 |  L +^PS(55,PSJDFN,"IVBCMA"):10
 | 
|---|
| 21 |  E  W "Waiting for lock..." F  L +^PS(55,PSJDFN,"IVBCMA"):5 Q:$T  W "."
 | 
|---|
| 22 |  S SEQ=$O(^PS(55,PSJDFN,"IVBCMA"," "),-1)
 | 
|---|
| 23 |  S PSJBCID=PSJDFN_"V"_(SEQ+1)
 | 
|---|
| 24 |  D UP1^PSIVBCID(DFN,ON,PSJBCID,PSIVCTD,PSIV1,PSIV2,PSIVNOL)
 | 
|---|
| 25 |  L -^PS(55,PSJDFN,"IVBCMA")
 | 
|---|
| 26 |  Q PSJBCID
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 | UP1(DFN,ON,PSJBCID,PSIVCTD,PSIV1,PSIV2,PSIVNOL) ;update initial data for bar code ID
 | 
|---|
| 29 |  ;Input:  DFN     - patient's IEN
 | 
|---|
| 30 |  ;        ON      - Order number for this bar code ID
 | 
|---|
| 31 |  ;        PSJBCID - bar code ID to be filed
 | 
|---|
| 32 |  ;        PSIVCTD - the $D(PSIVCT) from the calling routine, if PSIVCT was defined, then the labels won't be counted
 | 
|---|
| 33 |  ;        PSIV1   - current label number
 | 
|---|
| 34 |  ;        PSIV2   -
 | 
|---|
| 35 |  ;        PSIVNOL - total number of labels
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  ;Output:  PSJBLN - label sequence number
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 |  S PSIV1=$G(PSIV1),PSIV2=$G(PSIV2),PSIVNOL=$G(PSIVNOL)
 | 
|---|
| 40 |  K DIC,DIE,DO S DIC(0)="L",DA(1)=DFN,X=PSJBCID,DIC="^PS(55,"_DA(1)_",""IVBCMA""," D FILE^DICN
 | 
|---|
| 41 |  K DA,DR,DIE S DIE=DIC,DA=+Y,DA(1)=DFN,PSJBLN=DA D NOW^%DTC
 | 
|---|
| 42 |  S DR=".02////"_+ON_";3////"_$S(PSIVCTD:0,1:1)_";4////"_$E(%,1,12)_";6////"_PSIV1_"["_$S(PSIV1:PSIVNOL,1:PSIV2)_"]" D ^DIE
 | 
|---|
| 43 |  K DIC,DIE,D0,DA,DR
 | 
|---|
| 44 |  Q
 | 
|---|
| 45 | UP2(DFN,PSJBLN,PSIV,YY) ;update additive data for bar code ID
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 |  ;Input:  DFN    - Patient's IEN
 | 
|---|
| 48 |  ;        PSJBLN - The IEN for the bar code ID
 | 
|---|
| 49 |  ;        PSIV   - the sequence number for this additive
 | 
|---|
| 50 |  ;        YY     - ADDITIVE ^ STRENGTH ^ BOTTLE
 | 
|---|
| 51 |  ;
 | 
|---|
| 52 |  K DA,DR,DIC,DO S DIC(0)="L",DA(1)=DFN,DA(2)=PSJBLN,X=PSIV,DIC="^PS(55,"_DA(1)_",""IVBCMA"","_DA(2)_",""AD""," D FILE^DICN
 | 
|---|
| 53 |  K DA,DR,DIE S DIE=DIC,DA=+Y,DA(1)=PSJBLN,DA(2)=DFN S DR=".01////"_$P(YY,U)_";1////"_$P(YY,U,2)_";2////"_$P(YY,U,3) D ^DIE
 | 
|---|
| 54 |  K DA,DR,DIC,D0,DIE
 | 
|---|
| 55 |  Q
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 | UP3(DFN,PSJBLN,PSIV,YY) ;update solution data for bar code ID
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 |  ;Input:  DFN    - Patient's IEN
 | 
|---|
| 60 |  ;        PSJBLN - The IEN for the bar code ID
 | 
|---|
| 61 |  ;        PSIV   - the sequence number for this solution
 | 
|---|
| 62 |  ;        YY     - SOLUTION ^ VOLUME
 | 
|---|
| 63 |  ;
 | 
|---|
| 64 |  K DA,DR,DIC,DO S DIC(0)="L",DA(1)=DFN,DA(2)=PSJBLN,X=$P(PSIV,U),DIC="^PS(55,"_DA(1)_",""IVBCMA"","_DA(2)_",""SOL""," D FILE^DICN
 | 
|---|
| 65 |  K DA,DR,DIE S DIE=DIC,DA=+Y,DA(1)=PSJBLN,DA(2)=DFN S DR=".01////"_$P(YY,U)_";1////"_$P(YY,U,2) D ^DIE
 | 
|---|
| 66 |  K DA,DR,DIC,D0,DIE
 | 
|---|
| 67 |  Q
 | 
|---|