| 1 | PSIVRDC ;BIR/MV - RECYCLE, CANCEL, DESTROY ACTIONS ;30 Aug 2001  4:21 PM
 | 
|---|
| 2 |  ;;5.0; INPATIENT MEDICATIONS ;**85**;16 DEC 97
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;;Reference to ^PS(55 is supported by DBIA 2191
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 | EN ;
 | 
|---|
| 7 |  NEW CHK,PSGDT,PSIVPL,PSIVPR,PSIVSITE,PSIVSN,PSJSYSL,PSJSYSP,PSJSYSP0,PSJSYSU
 | 
|---|
| 8 |  D ^PSIVXU Q:$D(XQUIT)
 | 
|---|
| 9 |  NEW DA,DIC,DIR,X,X,Y
 | 
|---|
| 10 |  W !
 | 
|---|
| 11 |  F  K DIR S DIR(0)="SOA^R:RECYCLE;C:CANCEL;D:DESTROY",DIR("A")="Enter action to take (Recycle/Cancel/Destroy): " D ^DIR Q:$S(Y="R":0,Y="C":0,Y="D":0,1:1)  D GTID(Y)
 | 
|---|
| 12 |  Q
 | 
|---|
| 13 | GTID(PSJRDC) ;
 | 
|---|
| 14 |  F  K DIR S DIR(0)="FO^1:50",DIR("A")="Scan Barcode to "_$$TXT(PSJRDC) D  Q:X=""!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)  D UPDID($$UP^XLFSTR(X),PSJRDC)
 | 
|---|
| 15 |  . S DIR("?")="Please enter the barcode ID" D ^DIR
 | 
|---|
| 16 |  Q
 | 
|---|
| 17 | UPDID(PSJID,PSJRDC)        ;
 | 
|---|
| 18 |  NEW ACTION,DA,DIC,DFN,ON,LABELS,PSIVNOL,PSJLB,X,Y
 | 
|---|
| 19 |  I '$D(^PS(55,+$P(PSJID,"V"),"BCMA",PSJID)) W !,"...Invalid ID number.  Please try again.",!! Q
 | 
|---|
| 20 |  S DA(1)=$P(PSJID,"V"),DIC="^PS(55,"_DA(1)_",""IVBCMA"",",X=$P(PSJID,"V",2),DIC(0)="ZQ" D ^DIC
 | 
|---|
| 21 |  I Y=-1 W !!,"...Invalid ID number.  Please try again.",!! Q
 | 
|---|
| 22 |  W !
 | 
|---|
| 23 |  F X=1:1:8 S PSJLB(X)=$P(Y(0),U,X)
 | 
|---|
| 24 |  I $S(PSJLB(4)]""&("CGIS"[PSJLB(4)):1,PSJLB(7)="RP":0,PSJLB(7)]"":1,1:0) D  Q
 | 
|---|
| 25 |  . W !,"...The ID entered was marked as "
 | 
|---|
| 26 |  . W $S(PSJLB(4)="C":"Completed.",PSJLB(4)="G":"Given.",PSJLB(4)="I":"Infusing.",PSJLB(4)="S":"Stop.",PSJLB(7)="CA":"Cancel.",PSJLB(7)="DT":"Destroy.",PSJLB(7)="RC":"Recycle.",1:""),!
 | 
|---|
| 27 |  S ON=PSJLB(2),DFN=$P(PSJID,"V")
 | 
|---|
| 28 |  D DSPLY
 | 
|---|
| 29 |  K DIR S DIR(0)="FO^1:50",DIR("A")=$$TXT(PSJRDC),DIR("B")=PSJID D ^DIR
 | 
|---|
| 30 |  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
 | 
|---|
| 31 |  I X'=PSJID W !,"...Barcode ID did not match.  No action was taken." W ! Q
 | 
|---|
| 32 |  K DA,DR,DIE,DIC,DIR
 | 
|---|
| 33 |  D NOW^%DTC
 | 
|---|
| 34 |  S DA=$P(PSJID,"V",2),DA(1)=DFN,DIE="^PS(55,"_DA(1)_",""IVBCMA"","
 | 
|---|
| 35 |  S DR="4////"_%_";5////"_$S(PSJRDC="R":"RC",PSJRDC="D":"DT",1:"CA") D ^DIE
 | 
|---|
| 36 |  K DA,DR,DIE,DIC,DTOUT,DUOUT,DIROUT
 | 
|---|
| 37 |  S PSIVNOL=1,LABELS=1,ACTION=$S(PSJRDC="R":2,PSJRDC="D":3,1:4) D ^PSIVLTR,^PSIVSTAT
 | 
|---|
| 38 |  W !,"...Done!",!!
 | 
|---|
| 39 |  Q
 | 
|---|
| 40 | DSPLY ;Display the patient name, additives/solutions.
 | 
|---|
| 41 |  NEW PSJAS,PSJADSOL,PSJL,PSJLBN,PSJLEN,PSJLN,VA,VADM,X
 | 
|---|
| 42 |  K ^TMP("PSIVLB",$J)
 | 
|---|
| 43 |  D DEM^VADPT
 | 
|---|
| 44 |  S PSJL="",(PSJLEN,PSJLN)=1,PSJLBN=$P(PSJID,"V",2)
 | 
|---|
| 45 |  F PSJAS="AD","SOL" D ADSOL^PSIVLB(PSJAS)
 | 
|---|
| 46 |  W !,VADM(1),!
 | 
|---|
| 47 |  F X=0:0 S X=$O(^TMP("PSIVLB",$J,X)) Q:'X  W !,^(X,0)
 | 
|---|
| 48 |  W !
 | 
|---|
| 49 |  K ^TMP("PSIVLB",$J)
 | 
|---|
| 50 |  Q
 | 
|---|
| 51 | TXT(X) ;Expand the set of code to text.
 | 
|---|
| 52 |  Q $S(X="R":"Recycle",X="C":"Cancel",X="D":"Destroy",1:"")
 | 
|---|