source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEMP.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1DGQEMP ;RWA/SLC-DHW/OKC-ALB/MIR - EMBOSSER PRINT;04/02/85 5:48 PM ; 11 Feb 86 10:04 AM
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 ;DGEMBTYP = device type (1 for embosser, 2 for addressograph, and 0 for plain printer
5 ;
6EN S %ZIS="",IOP="HOME" D ^%ZIS S DGI=$O(^DIC(39.3,"B",ION,0)),DGEMBTYP=0 K IOP,%ZIS
7 I DGI,$D(^DIC(39.3,DGI,0)) S DGEMBTYP=$P(^(0),"^",2)
8 I DGEMBTYP<0!(DGEMBTYP>2) G Q
9 K DGFORMAT,CARD S (DGCOUNT,DGTRY,DGSOFT,DGHARD,DGUNK)=0
10PRINT S:'$D(DGQUAN) DGQUAN=1 S ERR=0 D @(DGEMBTYP)
11 I ERR S DGTRY=DGTRY+1 D MAIL G:'REC&(DGTRY'>2) PRINT D HOLD^DGQEMA1
12 ;
13 ;update file statistics
14 ;
15 I 'DGI G Q
16 I '$D(^DIC(39.3,DGI,1,0)) S ^DIC(39.3,DGI,1,0)="^39.31A^^"
17 S X="" I $D(^DIC(39.3,DGI,1,DT,0)) S X=^(0)
18 S DGNUM=$P(X,"^",1),DGSOFER=$P(X,"^",2),DGHER=$P(X,"^",3),DGUKER=$P(X,"^",4)
19 S DIC="^DIC(39.3,"_DGI_",1,"
20 I '$D(^DIC(39.3,DGI,1,DT)) S DINUM=DT,DIC(0)="L",DA(1)=DGI,X=DGCOUNT D ^DIC
21 I $D(^DIC(39.3,DGI,1,DT)) S DIE=DIC,DA=DT,DR=".01///"_(DGCOUNT+DGNUM)_";1///"_(DGSOFT+DGSOFER)_";2///"_(DGHARD+DGHER)_";3///"_(DGUNK+DGUKER) D ^DIE
22 ;I DGCOUNT<DGQUAN S DGQUAN=DGQUAN-DGCOUNT G PRINT
23Q D KILL^%ZTLOAD K DFN,DGCOUNT,DGCT,DGEMBTYP,DGHARD,DGF,DGFORMAT,DGHER,DGI,DGLINE,DGNUM,DGQUAN,DGSOFER,DGSOFT,DGTRY,DGUKER,DGUNK,ERR,F,FM,I,J,K,POP,REC,X,XMB,XMDUZ,Y
24 K DA,DIC,DIE,DINUM
25 Q
26MAIL I $L($P(^DIC(39.1,DGTYP,0),"^",5)),$P(^(0),"^",5)="Y" S XMY(DUZ)=""
27 S XMDUZ=.5,XMB=$S(REC:"DG EMBOSSER1",1:"DG EMBOSSER"),XMB($S(REC:1,1:2))=$S($D(^DPT(+DFN,0)):$P(^(0),"^",1),1:"UNSPECIFIED")
28 I 'REC S XMB(1)=$P(^DIC(39.1,DGTYP,0),"^",1)
29 D ^XMB
30 K XMB,XMDUZ Q
31 ;
32 ;
33BATCH ;process cards in hold status
34 F DGCD=0:0 S DGCD=$O(^DIC(39.1,DGTYP,"HOLD",DGCD)) Q:'DGCD I $D(^(DGCD,0)) S DFN=+^(0),DGQUAN=$P(^(0),"^",2) D TEXT
35 S DIK="^DIC(39.1,"_DGTYP_",""HOLD"",",DA(1)=DGTYP F DA=0:0 S DA=$O(^DIC(39.1,DGTYP,"HOLD",DA)) Q:'DA D ^DIK
36 K DA,DIK,DGCD,DGTYP Q
37 ;
38TEXT ;get text from cards in hold
39 F K=1:1:9 I $D(^DIC(39.1,DGTYP,"HOLD",DGCD,1,K,0)) S DGLINE(K)=^(0)
40 I $D(DGLINE(1)) D EN ;print card
41 Q
42 ;
43 ;
44 ;WARNING!!!
45 ;This section prints the patient data cards and interacts with the
46 ;embosser and addressograph
47 ;
48 ;Line tags:
49 ; 0 - for plain printer
50 ; 1 - for embosser
51 ; 2 - for addressograph
52 ;
53 ;
540 ;plain paper printer
55 F I=1:1:DGQUAN S DGCOUNT=DGCOUNT+1 W:I>1 !!!!!! F L=1:1:9 I $D(DGLINE(L)) W !,DGLINE(L)
56 W @IOF
57 Q
58 ;
59 ;
601 ;embosser
61 S (REC,F,K,X)=0,DGF=2 X ^%ZOSF("EOFF"),^%ZOSF("TYPE-AHEAD")
62 S FM=$S($D(DGFORMAT):9,1:0)
63 F I=1:1 R *X:0 Q:'$T
64A0 R *X:30 S X=$C(X) I X="" S DGUNK=1 G ERR
65 I FM=1 S FM=2 G S1:X="B",H1:X="H",X1:X'="C" S DGFORMAT=1 G A0
66 G A1:X="A",H1:X="H",S1:X="B",X1
67 ;
68A1 G S2:'FM D SB1 S REC=1
69 F I=1:1:DGQUAN R *X:200 S X=$C(X) G S1:X="B",H1:X="H",X1:X'="C" S K=K+1
70 G END
71S1 G ERR:F>DGF R *X:30 S X=$C(X),F=F+1,DGSOFT=DGSOFT+1 G H1:X="H",ERR:X'="A"
72S2 D SB2 S FM=1 G A0
73H1 S DGHARD=DGHARD+1 G ERR
74X1 S DGUNK=DGUNK+1 G ERR:F>DGF S F=F+1 G A0
75ERR S ERR=1
76END S DGCOUNT=K Q
77SB1 W "#DCC##REP#",DGQUAN,"#EMB#" F L=1:1:9 Q:'$D(DGLINE(L)) W DGLINE(L),""""
78 W "#END#@@@@@@" Q
79SB2 W "#DCL#080400 1#FC1#1550 2#FC1#1400 3#FC1#1250"
80 W " 4#FC1#1100 5#FC1#0950 6#FC1#0800 7#FC1#0650"
81 W " 8#FC1#0500 9#FC1#0350#END#@@@@@@" Q
82 ;
83 ;
842 ;addressograph
85 F I=1:1:DGQUAN D ADD S DGCOUNT=DGCOUNT+1
86 Q
87ADD F L=1:1:12 W *0
88 W "<" F L=1:1:9 Q:'$D(DGLINE(L)) W !,"+00000",(L-1),"0",DGLINE(L)
89 W ">" Q
Note: See TracBrowser for help on using the repository browser.