PSOLLU3 ;BIR/JLC - BUILD CONTROL CODES ;01/24/2003
;;7.0;OUTPATIENT PHARMACY;**141,135**;DEC 1997
;
;Read-only reference to %ZIS(2 supported by DBIA 3435
;Reference to %ZIS(2 supported by DBIA 3884
;
N IO,IOST
IO D ^%ZIS
I '$G(IOST(0)) W "No terminal type available." Q
I '$D(DUZ(0)) W "No DUZ defined." Q
I DUZ(0)'="@" W "FileMan access must be @." Q
I '$D(^%ZIS(2,IOST(0),55,"B","LL")) W "No CONTROL CODES defined." Q
W !!,"You will be copying the CONTROL CODES to device: ",IO," are you sure? " R ANS:60 W " " I ANS'="Y" G IO
W "Copying..."
S AB="F6B",NAME="SIX POINT FONT, BOLDED",CODE="W *27,""(10U"",*27,""(s1p6v0s3b16602T""" D FILE
S AB="F8B",NAME="EIGHT POINT FONT, BOLDED",CODE="W *27,""(10U"",*27,""(s1p8v0s3b16602T""" D FILE
S AB="F9B",NAME="NINE POINT FONT, BOLDED",CODE="W *27,""(10U"",*27,""(s1p9v0s3b16602T""" D FILE
S AB="F10B",NAME="TEN POINT FONT, BOLDED",CODE="W *27,""(10U"",*27,""(s1p10v0s3b16602T""" D FILE
S AB="F12B",NAME="12 POINT FONT BOLDED",CODE="W *27,""(10U"",*27,""(s1p12v0s3b16602T""" D FILE
S AB="RMI",NAME="RETURN MAIL INITIALIZATION",CODE="S PSOHFONT=""F8"",PSOFONT=""F10"",PSOX=1700,PSOY=35,PSORYI=40,PSOHYI=40,PSOTFONT=""F8"",PSOTY=550" D FILE
Q
FILE K DIC,DIE S DIC(0)="L",DA(1)=IOST(0),X=AB,DIC="^%ZIS(2,"_DA(1)_",55," D FILE^DICN
K DA,DR,DIE S DIE=DIC,DA=+Y,DA(1)=IOST(0)
S DR=".01////"_AB_";1////"_NAME_";2////"_CODE D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLU3 1415 printed Sep 23, 2025@20:07:10 Page 2
PSOLLU3 ;BIR/JLC - BUILD CONTROL CODES ;01/24/2003
+1 ;;7.0;OUTPATIENT PHARMACY;**141,135**;DEC 1997
+2 ;
+3 ;Read-only reference to %ZIS(2 supported by DBIA 3435
+4 ;Reference to %ZIS(2 supported by DBIA 3884
+5 ;
+6 NEW IO,IOST
IO DO ^%ZIS
+1 IF '$GET(IOST(0))
WRITE "No terminal type available."
QUIT
+2 IF '$DATA(DUZ(0))
WRITE "No DUZ defined."
QUIT
+3 IF DUZ(0)'="@"
WRITE "FileMan access must be @."
QUIT
+4 IF '$DATA(^%ZIS(2,IOST(0),55,"B","LL"))
WRITE "No CONTROL CODES defined."
QUIT
+5 WRITE !!,"You will be copying the CONTROL CODES to device: ",IO," are you sure? "
READ ANS:60
WRITE " "
IF ANS'="Y"
GOTO IO
+6 WRITE "Copying..."
+7 SET AB="F6B"
SET NAME="SIX POINT FONT, BOLDED"
SET CODE="W *27,""(10U"",*27,""(s1p6v0s3b16602T"""
DO FILE
+8 SET AB="F8B"
SET NAME="EIGHT POINT FONT, BOLDED"
SET CODE="W *27,""(10U"",*27,""(s1p8v0s3b16602T"""
DO FILE
+9 SET AB="F9B"
SET NAME="NINE POINT FONT, BOLDED"
SET CODE="W *27,""(10U"",*27,""(s1p9v0s3b16602T"""
DO FILE
+10 SET AB="F10B"
SET NAME="TEN POINT FONT, BOLDED"
SET CODE="W *27,""(10U"",*27,""(s1p10v0s3b16602T"""
DO FILE
+11 SET AB="F12B"
SET NAME="12 POINT FONT BOLDED"
SET CODE="W *27,""(10U"",*27,""(s1p12v0s3b16602T"""
DO FILE
+12 SET AB="RMI"
SET NAME="RETURN MAIL INITIALIZATION"
SET CODE="S PSOHFONT=""F8"",PSOFONT=""F10"",PSOX=1700,PSOY=35,PSORYI=40,PSOHYI=40,PSOTFONT=""F8"",PSOTY=550"
DO FILE
+13 QUIT
FILE KILL DIC,DIE
SET DIC(0)="L"
SET DA(1)=IOST(0)
SET X=AB
SET DIC="^%ZIS(2,"_DA(1)_",55,"
DO FILE^DICN
+1 KILL DA,DR,DIE
SET DIE=DIC
SET DA=+Y
SET DA(1)=IOST(0)
+2 SET DR=".01////"_AB_";1////"_NAME_";2////"_CODE
DO ^DIE
+3 QUIT
