source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVBCID.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1PSIVBCID ;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 ;
6BCMA(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 ;
28UP1(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
45UP2(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 ;
57UP3(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
Note: See TracBrowser for help on using the repository browser.