1 | PSIVLBRP ;BIR/MV - REPRINT LABELS FOR AN ORDER ;15 May 2001 3:29 PM
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;**58,97**;16 DEC 97
|
---|
3 | ;
|
---|
4 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
---|
5 | ;
|
---|
6 | EN(PSJIDLST) ;
|
---|
7 | I '$D(PSJIDLST) W !,"No labels are available" D PAUSE^VALM1 Q
|
---|
8 | NEW DIR,PSIVCTD
|
---|
9 | S PSIVCT=1
|
---|
10 | W !!,"Count as daily usage" S %=1 D YN^DICN Q:%=-1 S PSIVCTD=$S(%=1:1,1:0)
|
---|
11 | I PSIVCTD=1 K PSIVCT
|
---|
12 | S PSJY=$$PROMPT()
|
---|
13 | Q:PSJY=""
|
---|
14 | D PRT
|
---|
15 | Q
|
---|
16 | PROMPT() ;
|
---|
17 | W !
|
---|
18 | S DIR(0)="LOA^1:"_PSJIDLST,DIR("A")="Select from 1 - "_PSJIDLST_" or <RETURN> to select by BCMA ID: " D ^DIR
|
---|
19 | K DIR
|
---|
20 | S PSJY=Y
|
---|
21 | I PSJY="" S DIR(0)="FOA^1:50^S X=$$UP^XLFSTR(X) K:'$D(PSJIDLST(X)) X",DIR("A")="Enter a BCMA ID: " D ^DIR S PSJY=$$UP^XLFSTR(Y)
|
---|
22 | K DIR
|
---|
23 | W !!
|
---|
24 | Q PSJY
|
---|
25 | DEQIA ;
|
---|
26 | S PSIVNOL=0
|
---|
27 | F PSJSEL=1:1 S PSJSEL1=$P(PSJY,",",PSJSEL) Q:PSJSEL1="" S PSIVNOL=PSIVNOL+1
|
---|
28 | F PSJSEL=1:1 S PSJSEL1=$P(PSJY,",",PSJSEL) Q:PSJSEL1="" D
|
---|
29 | . S:'PSIVCTD PSIVCT=1
|
---|
30 | . S PSJID=$G(PSJIDLST(PSJSEL1)) Q:PSJID="" D REPRT(PSJID)
|
---|
31 | K PSJRPHD
|
---|
32 | Q
|
---|
33 | REPRT(PSJID) ;
|
---|
34 | S PSJNEWID=$$BCMA^PSIVBCID(DFN,ON,$D(PSIVCT),$G(PSIV1),$G(PSIV2),$G(PSIVNOL))
|
---|
35 | I PSJNEWID="" W !,"Can't get a new BCMA ID. Try again" Q
|
---|
36 | S PSJIDNO=$P(PSJID,"V",2)
|
---|
37 | S PSIVBAG=$P($G(^PS(55,DFN,"IVBCMA",PSJIDNO,0)),U,8)
|
---|
38 | N DA,DR,DIE,DIC
|
---|
39 | ;S DIC(0)="L",DA=Y,DA(1)=DFN,X=PSJNEWID,DIC="^PS(55,"_DA(1)_",""IVBCMA""," D FILE^DICN
|
---|
40 | K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IVBCMA"",",DA=$P(PSJNEWID,"V",2),DA(1)=DFN D NOW^%DTC
|
---|
41 | ;S DR=".02////"_+ON_";3////"_PSIVCTD_";4////"_$E(%,1,12)_";6////"_PSIVBAG D ^DIE
|
---|
42 | S DR="6////"_PSIVBAG D ^DIE
|
---|
43 | K DA,DR,DIE,DIC
|
---|
44 | S PSJNEWID=$P(PSJNEWID,"V",2)
|
---|
45 | F PSJAD=0:0 S PSJAD=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",PSJAD)) Q:'PSJAD D
|
---|
46 | . S PSJADX=$G(^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",PSJAD,0))
|
---|
47 | . D UP2^PSIVBCID(DFN,PSJNEWID,PSJAD,PSJADX)
|
---|
48 | F PSJSOL=0:0 S PSJSOL=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",PSJSOL)) Q:'PSJSOL D
|
---|
49 | . S PSJSOLX=$G(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",PSJSOL,0))
|
---|
50 | . D UP3^PSIVBCID(DFN,PSJNEWID,PSJSOL,PSJSOLX)
|
---|
51 | K DA,DR,DIE,DIC
|
---|
52 | S DA=PSJIDNO,DA(1)=DFN,DIE="^PS(55,"_DA(1)_",""IVBCMA"","
|
---|
53 | S DR="5////RP" D ^DIE
|
---|
54 | K DA,DR,DIE,DIC
|
---|
55 | D ^PSIVHYPR:P(4)="H",^PSIVLABR:"APSC"[P(4) S:$D(ZTQUEUED) ZTREQ="@"
|
---|
56 | ;PSJRPHD is defined so ^PSIVLABR won't print the header for sub-labels.
|
---|
57 | S PSJRPHD=1
|
---|
58 | ;If reprinting from war/man list, store new BCMA ID.
|
---|
59 | S:$G(PSIVWMFL) PSIVID(PSJNEWID)=""
|
---|
60 | Q
|
---|
61 | PRT ;
|
---|
62 | S IONOFF="",IOP=PSIVPL,%ZIS="NQ" D ^%ZIS G:POP Q I IO=IO(0),($E(IOST)="C") W !!! D DEQIA,Q D HOME^%ZIS Q
|
---|
63 | D HOME^%ZIS
|
---|
64 | W ! S ZTDTH=$H,ZTIO=PSIVPL,ZTDESC="REPRINT INDIVIDUAL IV LABELS",ZTRTN="DEQIA^PSIVLBRP" F X="IONOFF","P16","PSIVAC","PSIVSN","PSIVSITE","DFN","ON","PSJSYSW0","PSJSYSU","PSJSYSP0","PSJIDLST(","P(","PSJY","PSIVCTD" S ZTSAVE(X)=""
|
---|
65 | S:$D(PSIVCT) ZTSAVE("PSIVCT")="" D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
|
---|
66 | Q
|
---|
67 | Q ;
|
---|
68 | Q
|
---|