PSDORN3.m

PSDORN3 ;BIR/LTL-Nurse CS INF Order Entry Print emer order (cont'd) ;12/14/99  16:16

 ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97

 ;

 ; Reference to DD(58.8 supported by DBIA # 10154

 ; Reference to $$FMTE^XLFDT( supported by DBIA # 10103

 ; Reference to DPT( supported by DBIA # 10035

 ; Reference to VA(200 supported by DBIA # 10060

 ; Reference to PSD(58.8 supported by DBIA # 2711

 ;

 N Y,ZTRTN,ZTDTH,ZTSK,ZTDESC,ZTIO,ZTSAVE

 S ZTRTN="PRINT^PSDORN3",ZTDESC="Print a Controlled Subs order"

 S ZTDTH=$H,Y=$P($G(^PSD(58.8,+PSDS,2)),U,11),C=$P(^DD(58.8,29,0),U,2)

 D Y^DIQ I Y']"" W !!,"Pharmacy has not set up a priority order printer, you'll need to call." Q

 S ZTIO=Y,ZTSAVE("PSD*")="",ZTSAVE("REQD")="",ZTSAVE("NAOU*")="",ZTSAVE("PAT")=""

 W ?40,"Printing on ",Y,"..." D ^%ZTLOAD,HOME^%ZIS Q

PRINT W:$Y&(IOF]"") @IOF W "* CONT. SUBS. INFUSION ORDER *"

 W !!,"Date/Time Needed: ",$$FMTE^XLFDT($G(PSDT(9)),2)

 W !,"Patient: ",$P($G(^DPT(PAT,0)),U)

 W !,"Location",?14,": ",NAOUN

 W !,"Drug",?14,": ",!,PSDRN

 ;W !,"Quantity",?14,": ",PSDQTY

 W:'$P($G(^PSD(58.8,+PSDS,1,PSDR,0)),U,4) "  ZERO IN VAULT"

 W !,"Requested by",?14,": ",$P($G(^VA(200,PSDUZ,0)),"^")

 W !,"Worksheet #",?14,": ",PSDREC

 W !,"Comments:"

 I $D(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0)) K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,TEXT)) Q:'TEXT  D

 .S X=$G(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,TEXT,0)),DIWL=5,DIWR=75,DIWF="W" D ^DIWP

 I  D ^DIWW

 W:$Y&(IOF]"") @IOF

 S DIE="^PSD(58.85,",DA=PSDREC,DR="13////"_1 D ^DIE K DIE,DA,DR

 S ZTREQ="@" Q

PSDORN3   ;BIR/LTL-Nurse CS INF Order Entry Print emer order (cont'd) ;12/14/99  16:16

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97

 +2       ;

 +3       ; Reference to DD(58.8 supported by DBIA # 10154

 +4       ; Reference to $$FMTE^XLFDT( supported by DBIA # 10103

 +5       ; Reference to DPT( supported by DBIA # 10035

 +6       ; Reference to VA(200 supported by DBIA # 10060

 +7       ; Reference to PSD(58.8 supported by DBIA # 2711

 +8       ;

 +9        NEW Y,ZTRTN,ZTDTH,ZTSK,ZTDESC,ZTIO,ZTSAVE

 +10       SET ZTRTN="PRINT^PSDORN3"

           SET ZTDESC="Print a Controlled Subs order"

 +11       SET ZTDTH=$HOROLOG

           SET Y=$PIECE($GET(^PSD(58.8,+PSDS,2)),U,11)

           SET C=$PIECE(^DD(58.8,29,0),U,2)

 +12       DO Y^DIQ

           IF Y']""

               WRITE !!,"Pharmacy has not set up a priority order printer, you'll need to call."

               QUIT 

 +13       SET ZTIO=Y

           SET ZTSAVE("PSD*")=""

           SET ZTSAVE("REQD")=""

           SET ZTSAVE("NAOU*")=""

           SET ZTSAVE("PAT")=""

 +14       WRITE ?40,"Printing on ",Y,"..."

           DO ^%ZTLOAD

           DO HOME^%ZIS

           QUIT 

PRINT      IF $Y&(IOF]"")

               WRITE @IOF

           WRITE "* CONT. SUBS. INFUSION ORDER *"

 +1        WRITE !!,"Date/Time Needed: ",$$FMTE^XLFDT($GET(PSDT(9)),2)

 +2        WRITE !,"Patient: ",$PIECE($GET(^DPT(PAT,0)),U)

 +3        WRITE !,"Location",?14,": ",NAOUN

 +4        WRITE !,"Drug",?14,": ",!,PSDRN

 +5       ;W !,"Quantity",?14,": ",PSDQTY

 +6        IF '$PIECE($GET(^PSD(58.8,+PSDS,1,PSDR,0)),U,4)

               WRITE "  ZERO IN VAULT"

 +7        WRITE !,"Requested by",?14,": ",$PIECE($GET(^VA(200,PSDUZ,0)),"^")

 +8        WRITE !,"Worksheet #",?14,": ",PSDREC

 +9        WRITE !,"Comments:"

 +10       IF $DATA(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0))

               KILL ^UTILITY($JOB,"W")

               FOR TEXT=0:0

                   SET TEXT=$ORDER(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,TEXT))

                   IF 'TEXT

                       QUIT 

                   Begin DoDot:1

 +11                   SET X=$GET(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,TEXT,0))

                       SET DIWL=5

                       SET DIWR=75

                       SET DIWF="W"

                       DO ^DIWP

                   End DoDot:1

 +12      IF $TEST

               DO ^DIWW

 +13       IF $Y&(IOF]"")

               WRITE @IOF

 +14       SET DIE="^PSD(58.85,"

           SET DA=PSDREC

           SET DR="13////"_1

           DO ^DIE

           KILL DIE,DA,DR

 +15       SET ZTREQ="@"

           QUIT