source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVRDC.m@ 619

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PSIVRDC ;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 ;
6EN ;
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
13GTID(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
17UPDID(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
40DSPLY ;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
51TXT(X) ;Expand the set of code to text.
52 Q $S(X="R":"Recycle",X="C":"Cancel",X="D":"Destroy",1:"")
Note: See TracBrowser for help on using the repository browser.