PSDORNP.m

PSDORNP ;BIR/LTL-Nurse CS Order Entry Print Priority Order (cont'd) ; 17 Feb 95

 ;;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 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^PSDORNP",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*")=""

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

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

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

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

 W !,"Drug",?14,": ",!,PSDRN,!,"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

PSDORNP   ;BIR/LTL-Nurse CS Order Entry Print Priority Order (cont'd) ; 17 Feb 95

 +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 VA(200 supported by DBIA # 10060

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

 +7       ; 

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

 +9        SET ZTRTN="PRINT^PSDORNP"

           SET ZTDESC="Print a Controlled Subs order"

 +10       SET ZTDTH=$HOROLOG

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

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

 +11       DO Y^DIQ

           IF Y']""

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

               QUIT 

 +12       SET ZTIO=Y

           SET ZTSAVE("PSD*")=""

           SET ZTSAVE("REQD")=""

           SET ZTSAVE("NAOU*")=""

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

           DO ^%ZTLOAD

           DO HOME^%ZIS

           QUIT 

PRINT      IF $Y&(IOF]"")

               WRITE @IOF

           WRITE "* PRIORITY CONT. SUBS. ORDER *"

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

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

 +3        WRITE !,"Drug",?14,": ",!,PSDRN,!,"Quantity",?14,": ",PSDQTY

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

               WRITE "  ZERO IN VAULT"

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

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

 +7        WRITE !,"Comments:"

 +8        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

 +9                    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

 +10      IF $TEST

               DO ^DIWW

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

               WRITE @IOF

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

           SET DA=PSDREC

           SET DR="13////"_1

           DO ^DIE

           KILL DIE,DA,DR

 +13       SET ZTREQ="@"

           QUIT