- PSIVRDC ;BIR/MV - RECYCLE, CANCEL, DESTROY ACTIONS ;30 Aug 2001 4:21 PM
- ;;5.0; INPATIENT MEDICATIONS ;**85**;16 DEC 97
- ;
- ;;Reference to ^PS(55 is supported by DBIA 2191
- ;
- EN ;
- NEW CHK,PSGDT,PSIVPL,PSIVPR,PSIVSITE,PSIVSN,PSJSYSL,PSJSYSP,PSJSYSP0,PSJSYSU
- D ^PSIVXU Q:$D(XQUIT)
- NEW DA,DIC,DIR,X,X,Y
- W !
- 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)
- Q
- GTID(PSJRDC) ;
- 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)
- . S DIR("?")="Please enter the barcode ID" D ^DIR
- Q
- UPDID(PSJID,PSJRDC) ;
- NEW ACTION,DA,DIC,DFN,ON,LABELS,PSIVNOL,PSJLB,X,Y
- I '$D(^PS(55,+$P(PSJID,"V"),"BCMA",PSJID)) W !,"...Invalid ID number. Please try again.",!! Q
- S DA(1)=$P(PSJID,"V"),DIC="^PS(55,"_DA(1)_",""IVBCMA"",",X=$P(PSJID,"V",2),DIC(0)="ZQ" D ^DIC
- I Y=-1 W !!,"...Invalid ID number. Please try again.",!! Q
- W !
- F X=1:1:8 S PSJLB(X)=$P(Y(0),U,X)
- I $S(PSJLB(4)]""&("CGIS"[PSJLB(4)):1,PSJLB(7)="RP":0,PSJLB(7)]"":1,1:0) D Q
- . W !,"...The ID entered was marked as "
- . 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:""),!
- S ON=PSJLB(2),DFN=$P(PSJID,"V")
- D DSPLY
- K DIR S DIR(0)="FO^1:50",DIR("A")=$$TXT(PSJRDC),DIR("B")=PSJID D ^DIR
- I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
- I X'=PSJID W !,"...Barcode ID did not match. No action was taken." W ! Q
- K DA,DR,DIE,DIC,DIR
- D NOW^%DTC
- S DA=$P(PSJID,"V",2),DA(1)=DFN,DIE="^PS(55,"_DA(1)_",""IVBCMA"","
- S DR="4////"_%_";5////"_$S(PSJRDC="R":"RC",PSJRDC="D":"DT",1:"CA") D ^DIE
- K DA,DR,DIE,DIC,DTOUT,DUOUT,DIROUT
- S PSIVNOL=1,LABELS=1,ACTION=$S(PSJRDC="R":2,PSJRDC="D":3,1:4) D ^PSIVLTR,^PSIVSTAT
- W !,"...Done!",!!
- Q
- DSPLY ;Display the patient name, additives/solutions.
- NEW PSJAS,PSJADSOL,PSJL,PSJLBN,PSJLEN,PSJLN,VA,VADM,X
- K ^TMP("PSIVLB",$J)
- D DEM^VADPT
- S PSJL="",(PSJLEN,PSJLN)=1,PSJLBN=$P(PSJID,"V",2)
- F PSJAS="AD","SOL" D ADSOL^PSIVLB(PSJAS)
- W !,VADM(1),!
- F X=0:0 S X=$O(^TMP("PSIVLB",$J,X)) Q:'X W !,^(X,0)
- W !
- K ^TMP("PSIVLB",$J)
- Q
- TXT(X) ;Expand the set of code to text.
- Q $S(X="R":"Recycle",X="C":"Cancel",X="D":"Destroy",1:"")
- PSIVRDC ;BIR/MV - RECYCLE, CANCEL, DESTROY ACTIONS ;30 Aug 2001 4:21 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**85**;16 DEC 97
- +2 ;
- +3 ;;Reference to ^PS(55 is supported by DBIA 2191
- +4 ;
- EN ;
- +1 NEW CHK,PSGDT,PSIVPL,PSIVPR,PSIVSITE,PSIVSN,PSJSYSL,PSJSYSP,PSJSYSP0,PSJSYSU
- +2 DO ^PSIVXU
- IF $DATA(XQUIT)
- QUIT
- +3 NEW DA,DIC,DIR,X,X,Y
- +4 WRITE !
- +5 FOR
- KILL DIR
- SET DIR(0)="SOA^R:RECYCLE;C:CANCEL;D:DESTROY"
- SET DIR("A")="Enter action to take (Recycle/Cancel/Destroy): "
- DO ^DIR
- IF $SELECT(Y="R"
- QUIT
- DO GTID(Y)
- +6 QUIT
- GTID(PSJRDC) ;
- +1 FOR
- KILL DIR
- SET DIR(0)="FO^1:50"
- SET DIR("A")="Scan Barcode to "_$$TXT(PSJRDC)
- Begin DoDot:1
- +2 SET DIR("?")="Please enter the barcode ID"
- DO ^DIR
- End DoDot:1
- IF X=""!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- DO UPDID($$UP^XLFSTR(X),PSJRDC)
- +3 QUIT
- UPDID(PSJID,PSJRDC) ;
- +1 NEW ACTION,DA,DIC,DFN,ON,LABELS,PSIVNOL,PSJLB,X,Y
- +2 IF '$DATA(^PS(55,+$PIECE(PSJID,"V"),"BCMA",PSJID))
- WRITE !,"...Invalid ID number. Please try again.",!!
- QUIT
- +3 SET DA(1)=$PIECE(PSJID,"V")
- SET DIC="^PS(55,"_DA(1)_",""IVBCMA"","
- SET X=$PIECE(PSJID,"V",2)
- SET DIC(0)="ZQ"
- DO ^DIC
- +4 IF Y=-1
- WRITE !!,"...Invalid ID number. Please try again.",!!
- QUIT
- +5 WRITE !
- +6 FOR X=1:1:8
- SET PSJLB(X)=$PIECE(Y(0),U,X)
- +7 IF $SELECT(PSJLB(4)]""&("CGIS"[PSJLB(4)):1,PSJLB(7)="RP":0,PSJLB(7)]"":1,1:0)
- Begin DoDot:1
- +8 WRITE !,"...The ID entered was marked as "
- +9 WRITE $SELECT(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:""),!
- End DoDot:1
- QUIT
- +10 SET ON=PSJLB(2)
- SET DFN=$PIECE(PSJID,"V")
- +11 DO DSPLY
- +12 KILL DIR
- SET DIR(0)="FO^1:50"
- SET DIR("A")=$$TXT(PSJRDC)
- SET DIR("B")=PSJID
- DO ^DIR
- +13 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- +14 IF X'=PSJID
- WRITE !,"...Barcode ID did not match. No action was taken."
- WRITE !
- QUIT
- +15 KILL DA,DR,DIE,DIC,DIR
- +16 DO NOW^%DTC
- +17 SET DA=$PIECE(PSJID,"V",2)
- SET DA(1)=DFN
- SET DIE="^PS(55,"_DA(1)_",""IVBCMA"","
- +18 SET DR="4////"_%_";5////"_$SELECT(PSJRDC="R":"RC",PSJRDC="D":"DT",1:"CA")
- DO ^DIE
- +19 KILL DA,DR,DIE,DIC,DTOUT,DUOUT,DIROUT
- +20 SET PSIVNOL=1
- SET LABELS=1
- SET ACTION=$SELECT(PSJRDC="R":2,PSJRDC="D":3,1:4)
- DO ^PSIVLTR
- DO ^PSIVSTAT
- +21 WRITE !,"...Done!",!!
- +22 QUIT
- DSPLY ;Display the patient name, additives/solutions.
- +1 NEW PSJAS,PSJADSOL,PSJL,PSJLBN,PSJLEN,PSJLN,VA,VADM,X
- +2 KILL ^TMP("PSIVLB",$JOB)
- +3 DO DEM^VADPT
- +4 SET PSJL=""
- SET (PSJLEN,PSJLN)=1
- SET PSJLBN=$PIECE(PSJID,"V",2)
- +5 FOR PSJAS="AD","SOL"
- DO ADSOL^PSIVLB(PSJAS)
- +6 WRITE !,VADM(1),!
- +7 FOR X=0:0
- SET X=$ORDER(^TMP("PSIVLB",$JOB,X))
- IF 'X
- QUIT
- WRITE !,^(X,0)
- +8 WRITE !
- +9 KILL ^TMP("PSIVLB",$JOB)
- +10 QUIT
- TXT(X) ;Expand the set of code to text.
- +1 QUIT $SELECT(X="R":"Recycle",X="C":"Cancel",X="D":"Destroy",1:"")
