Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOTALK3

PSOTALK3.m

Go to the documentation of this file. 
  1. PSOTALK3 ;BIR/EJW - SCRIPTALK UTILITIES ;11/05/17  19:22
  1.  ;;7.0;OUTPATIENT PHARMACY;**135,200,268,502**;DEC 1997;Build 13
  1.  ;External reference to ^PS(59.7 controlled subscription by DBIA 694
  1. TTRANS ;RE-INITIALIZE SCRIPTALK PRINTER
  1.  D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
  1.  S ZTIO="`"_$P($G(^PS(59,PSOSITE,"STALK")),U)
  1.  I ZTIO="`" W !,"No ScripTalk printer defined for division." Q
  1.  S ZTDTH=$$NOW^XLFDT,ZTDESC="ScripTalk Printer Re-initialize"
  1.  S ZTRTN="TINIT^PSOTALK3",ZTSAVE("*")=""
  1.  D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
  1.  W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
  1.  Q
  1.  ;
  1. TINIT ;
  1.  W !,"^XA ^MD30 ^XZ"
  1.  W !,"^XA ^MD30 ^XZ"
  1.  W !,"^XA ~SD30 ^XZ"
  1.  W !,"^XA ^MFF,F ^XZ"
  1.  W !,"^XA ^LT20 ^XZ"
  1.  W !,"^XA ^MTT ^XZ"
  1.  W !,"^XA ^JUS ^XZ"
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. TEST ;
  1.  I $G(PSOTEST)?."?" R !,"Enter a Zebra Print Language test command to be sent",!,"to the ScripTalk printer: ",PSOTEST:DTIME
  1.  I $G(PSOTEST)="" Q
  1.  D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
  1.  S ZTIO="`"_$P($G(^PS(59,PSOSITE,"STALK")),U),ZTDTH=$$NOW^XLFDT,ZTDESC="ScripTalk Interface Test"
  1.  I ZTIO="`" W !,"No ScripTalk printer defined for division." Q
  1.  S ZTRTN="TPUT^PSOTALK3",ZTSAVE("*")=""
  1.  D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
  1.  W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
  1.  K PSOTEST
  1.  Q
  1. TPUT ;SET VARIABLE 'PSOTEST' TO OUTPUT STRING
  1.  W !,PSOTEST
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. TESTLAB ;
  1.  D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
  1.  S ZTIO="`"_$P($G(^PS(59,PSOSITE,"STALK")),U),ZTDTH=$$NOW^XLFDT,ZTDESC="ScripTalk Sample Label"
  1.  I ZTIO="`" W !,"No ScripTalk printer defined for division." Q
  1.  S ZTRTN="TLABEL^PSOTALK3",ZTSAVE("*")=""
  1.  W !,"The following test data will be sent to the ScripTalk printer:",! D TLABEL W !
  1.  D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
  1.  W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
  1.  Q
  1. TLABEL ;
  1.  W !,"^XA"
  1.  W !,"^FO250,700^XGE:RX.GRF^FS"
  1.  W !,"^FO250,700^XGE:RX.GRF^FS"
  1.  W !,"^AFR,20,10^FO531,50^FR^CI0^FD7305 N. MILITARY TRL  Exp: January 01,2002^FS"
  1.  W !,"^AFR,20,10^FO503,50^FR^CI0^FDRX#82382787 January 01,2001  Fill 01 OF 01^FS"
  1.  W !,"^AFR,20,10^FO475,50^FR^CI0^FDJOE VETERAN^FS"
  1.  W !,"^AFR,20,10^FO447,50^FR^CI0^FDTAKE 1 CAPSULE THREE TIMES DAILY^FS"
  1.  W !,"^AFR,20,10^FO419,50^FR^CI0^FD^FS"
  1.  W !,"^AFR,20,10^FO391,50^FR^CI0^FD^FS"
  1.  W !,"^AFR,20,10^FO363,50^FR^CI0^FD^FS"
  1.  W !,"^AFR,20,10^FO335,50^FR^CI0^FDDr. BEN CASEY MD^FS"
  1.  W !,"^AFR,20,10^FO279,50^FR^CI0^FDQTY: 24 TABS^FS"
  1.  W !,"^AFR,20,10^FO251,50^FR^CI0^FDAMOXICILLIN 500MG CAP^FS"
  1.  W !,"^RX01,JOE VETERAN^FS"
  1.  W !,"^RX02,AMOXICILLIN 500MG CAP^FS"
  1.  W !,"^RX03,TAKE 1 CAPSULE THREE TIMES DAILY ^FS"
  1.  W !,"^RX04,010101^FS"
  1.  W !,"^RX05,00^FS"
  1.  W !,"^RX06,020000^FS"
  1.  W !,"^RX07,BEN CASEY^FS"
  1.  W !,"^RX08,2928993888^FS"
  1.  W !,"^RX09,82382787^FS"
  1.  W !,"^RX10, ^FS"
  1.  W !,"^PQ1,0,1,Y"
  1.  W !,"^XZ"
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. STDEV ;Define ScripTalk printer for a Division or map another print device to the ScripTalk Printer
  1.  N PSOSITE,PSOTYPE
  1. STDEV1 ;
  1.  W !!!
  1.  K DIC,DIR,DIE,DA,DR
  1.  S DIR(0)="SBO^D:Division;P:Printer",DIR("A")="Define ScripTalk Printer by (D)ivision or (P)rinter mapping?"
  1.  S DIR("?")=" "
  1.  S DIR("?",1)="Enter D to define ScripTalk printer by Division or enter P to tie a ScripTalk"
  1.  S DIR("?",2)="printer to regular Pharmacy label printer(s) to control where the ScripTalk"
  1.  S DIR("?",3)="labels print for multi-divisions."
  1.  S PSOSITE=""
  1.  D ^DIR G:$D(DIRUT)!(Y<0) STDEVQ S PSOTYPE=Y
  1.  D STDEVM:PSOTYPE="P"
  1.  D STDEVD:PSOTYPE="D"
  1.  G STDEV1
  1. STDEVQ ;
  1.  K DIC,DIR,DIE,DA,DR,DIRUT,Y
  1.  Q
  1.  ;
  1. STDEVD ;Define ScripTalk device by division
  1.  W ! S DIC("A")="Division: ",DIC=59,DIC(0)="AEMQ"
  1.  S:$G(PSOVEX)'=1 DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
  1.  D ^DIC K DIC Q:$D(DIRUT)!(Y<0)
  1.  Q:+Y<0
  1.  S PSOSITE=+Y
  1.  S DIE="^PS(59,",DA=PSOSITE,DR="107;107.1;107.2" D ^DIE
  1.  Q
  1.  ;
  1. STDEVM ;Map a printer to a ScripTalk printer
  1.  S DIE="^PS(59.7,",DA=1,DR="47" L +^PS(59.7,1,47):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) D  I $T D ^DIE L -^PS(59.7,1,47)
  1.  . I '$T W !?5,"Another user is editing this entry."
  1.  Q
  1.  ;
  1. STVLP ;Define VOIDED label print by division
  1.  W ! S DIC("A")="Division: ",DIC=59,DIC(0)="AEMQ"
  1.  S:$G(PSOVEX)'=1 DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
  1.  D ^DIC K DIC Q:$D(DIRUT)!(Y<0)
  1.  Q:+Y<0
  1.  S PSOSITE=+Y
  1.  S DIE="^PS(59,",DA=PSOSITE,DR="107.3" D ^DIE
  1.  Q