source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTALK3.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSOTALK3 ;BIR/EJW - SCRIPTALK UTILITIES ;02 Oct 2003 7:31 AM
2 ;;7.0;OUTPATIENT PHARMACY;**135,200,268**;DEC 1997;Build 9
3 ;External reference to ^PS(59.7 controlled subscription by DBIA 694
4TTRANS ;RE-INITIALIZE SCRIPTALK PRINTER
5 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
6 S ZTIO="`"_$P($G(^PS(59,PSOSITE,"STALK")),U)
7 I ZTIO="`" W !,"No ScripTalk printer defined for division." Q
8 S ZTDTH=$$NOW^XLFDT,ZTDESC="Scriptalk Printer Re-initialize"
9 S ZTRTN="TINIT^PSOTALK3",ZTSAVE("*")=""
10 D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
11 W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
12 Q
13 ;
14TINIT ;
15 W !,"^XA ^MD30 ^XZ"
16 W !,"^XA ^MD30 ^XZ"
17 W !,"^XA ~SD30 ^XZ"
18 W !,"^XA ^MFF,F ^XZ"
19 W !,"^XA ^LT20 ^XZ"
20 W !,"^XA ^MTT ^XZ"
21 W !,"^XA ^JUS ^XZ"
22 S:$D(ZTQUEUED) ZTREQ="@"
23 Q
24 ;
25TEST ;
26 I $G(PSOTEST)?."?" R !,"Enter a Zebra Print Language test command to be sent",!,"to the ScripTalk printer: ",PSOTEST:DTIME
27 I $G(PSOTEST)="" Q
28 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
29 S ZTIO="`"_$P($G(^PS(59,PSOSITE,"STALK")),U),ZTDTH=$$NOW^XLFDT,ZTDESC="Scriptalk Interface Test"
30 I ZTIO="`" W !,"No ScripTalk printer defined for division." Q
31 S ZTRTN="TPUT^PSOTALK3",ZTSAVE("*")=""
32 D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
33 W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
34 K PSOTEST
35 Q
36TPUT ;SET VARIABLE 'PSOTEST' TO OUTPUT STRING
37 W !,PSOTEST
38 S:$D(ZTQUEUED) ZTREQ="@"
39 Q
40 ;
41TESTLAB ;
42 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
43 S ZTIO="`"_$P($G(^PS(59,PSOSITE,"STALK")),U),ZTDTH=$$NOW^XLFDT,ZTDESC="Scriptalk Sample Label"
44 I ZTIO="`" W !,"No ScripTalk printer defined for division." Q
45 S ZTRTN="TLABEL^PSOTALK3",ZTSAVE("*")=""
46 W !,"The following test data will be sent to the ScripTalk printer:",! D TLABEL W !
47 D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
48 W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
49 Q
50TLABEL ;
51 W !,"^XA"
52 W !,"^FO250,700^XGE:RX.GRF^FS"
53 W !,"^FO250,700^XGE:RX.GRF^FS"
54 W !,"^AFR,20,10^FO531,50^FR^CI0^FD7305 N. MILITARY TRL Exp: January 01,2002^FS"
55 W !,"^AFR,20,10^FO503,50^FR^CI0^FDRX#82382787 January 01,2001 Fill 01 OF 01^FS"
56 W !,"^AFR,20,10^FO475,50^FR^CI0^FDJOE VETERAN^FS"
57 W !,"^AFR,20,10^FO447,50^FR^CI0^FDTAKE 1 CAPSULE THREE TIMES DAILY^FS"
58 W !,"^AFR,20,10^FO419,50^FR^CI0^FD^FS"
59 W !,"^AFR,20,10^FO391,50^FR^CI0^FD^FS"
60 W !,"^AFR,20,10^FO363,50^FR^CI0^FD^FS"
61 W !,"^AFR,20,10^FO335,50^FR^CI0^FDDr. BEN CASEY MD^FS"
62 W !,"^AFR,20,10^FO279,50^FR^CI0^FDQTY: 24 TABS^FS"
63 W !,"^AFR,20,10^FO251,50^FR^CI0^FDAMOXICILLIN 500MG CAP^FS"
64 W !,"^RX01,JOE VETERAN^FS"
65 W !,"^RX02,AMOXICILLIN 500MG CAP^FS"
66 W !,"^RX03,TAKE 1 CAPSULE THREE TIMES DAILY ^FS"
67 W !,"^RX04,010101^FS"
68 W !,"^RX05,00^FS"
69 W !,"^RX06,020000^FS"
70 W !,"^RX07,BEN CASEY^FS"
71 W !,"^RX08,2928993888^FS"
72 W !,"^RX09,82382787^FS"
73 W !,"^RX10, ^FS"
74 W !,"^PQ1,0,1,Y"
75 W !,"^XZ"
76 S:$D(ZTQUEUED) ZTREQ="@"
77 Q
78 ;
79STDEV ;Define ScripTalk printer for a Division or map another print device to the ScripTalk Printer
80 N PSOSITE,PSOTYPE
81STDEV1 ;
82 W !!!
83 K DIC,DIR,DIE,DA,DR
84 S DIR(0)="SBO^D:Division;P:Printer",DIR("A")="Define ScripTalk Printer by (D)ivision or (P)rinter mapping?"
85 S DIR("?")=" "
86 S DIR("?",1)="Enter D to define ScripTalk printer by Division or enter P to tie a ScripTalk"
87 S DIR("?",2)="printer to regular Pharmacy label printer(s) to control where the ScripTalk"
88 S DIR("?",3)="labels print for multi-divisions."
89 S PSOSITE=""
90 D ^DIR G:$D(DIRUT)!(Y<0) STDEVQ S PSOTYPE=Y
91 D STDEVM:PSOTYPE="P"
92 D STDEVD:PSOTYPE="D"
93 G STDEV1
94STDEVQ ;
95 K DIC,DIR,DIE,DA,DR,DIRUT,Y
96 Q
97 ;
98STDEVD ;Define ScripTalk device by division
99 W ! S DIC("A")="Division: ",DIC=59,DIC(0)="AEMQ"
100 S:$G(PSOVEX)'=1 DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
101 D ^DIC K DIC Q:$D(DIRUT)!(Y<0)
102 Q:+Y<0
103 S PSOSITE=+Y
104 S DIE="^PS(59,",DA=PSOSITE,DR="107;107.1" D ^DIE
105 Q
106 ;
107STDEVM ;Map a printer to a ScripTalk printer
108 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)
109 . I '$T W !?5,"Another user is editing this entry."
110 Q
111 ;
Note: See TracBrowser for help on using the repository browser.