| [613] | 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
|
|---|
