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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1DGQEMA1 ;RWA/SLC-DHW/OKC-ALB/MIR - CONTINUATION OF EMBOSSER AUTO/QUEUE ; NOV 30 90
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 ;DGHD - 0 for ask, 1 for hold, 2 for print
5 ;
6EN I 'DGHD,$P(DGX,"^",3)'="" S DGHD=$P(DGX,"^",3)
7 I DGHD=1 D HOLD Q ;hold
8 I DGHD D PRINT Q ;don't hold - queue (DGHD=2)
9 ;
10 ;falls through if ASK or unanswered
11 ;
12ASK W !,"Print or Hold ",$P(^DIC(39.1,DGTYP,0),"^",1)," Cards: " R X:DTIME I '$T!(X["^") D NO Q
13 S Z="^PRINT^HOLD" D IN^DGHELP I %<0 W !?3,"Enter 'P'rint or 'H'old" G ASK
14 I X="P" D PRINT Q
15 ;
16 ;
17HOLD S I=0,AMT=0
18 I '$D(^DIC(39.1,DGTYP,"HOLD",0)) S ^DIC(39.1,DGTYP,"HOLD",0)="^39.13P^^"
19 F I=0:0 S I=$O(^DIC(39.1,DGTYP,"HOLD",I)) Q:'I S AMT=I
20 S ^DIC(39.1,DGTYP,"HOLD",AMT+1,0)=DFN_"^"_DGQUAN
21 F K=1:1:9 S ^DIC(39.1,DGTYP,"HOLD",AMT+1,1,K,0)=$S($D(DGLINE(K)):DGLINE(K),1:"")
22 W:'$D(DGCOUNT) !,"Data Card Placed in Hold to be Printed Later!"
23 Q
24 ;
25 ;
26PRINT ;queue data card
27 S ZTRTN="DGQEMP",ZTSAVE("DGTYP")=S,ZTSAVE("DFN")="",ZTSAVE("DGLINE(")="",ZTSAVE("DGQUAN")="",ZTDESC="Print Data Card"
28 ;
29QUEUE K DIC I $D(^DIC(39.3,+$P(DGX,"^",2),0)) S DIC("B")=$P(^(0),"^",1)
30 S DIC=39.3,DIC(0)="AEQM",DIC("A")="Queue to print "_$P(^DIC(39.1,DGTYP,0),"^",1)_" cards on device: " D ^DIC I Y<0 D NO Q
31 D NOW^%DTC S ZTDTH=%
32 S ZTIO=$P(Y,"^",2) D ^%ZTLOAD W !,"Data card queued"
33 Q
34 ;
35 ;
36EDIT ;Edit free text data card
37 W !! F K=1:1:9 I $D(DGLINE(K)) W !?3,K,"> ",DGLINE(K)
38YN W !,"Edit Data" S %=2 D YN^DICN I %=2!(%Y["^"),'$D(DTOUT) D NUM^DGQEMA G NO:DGMANFL D EN Q
39 I %<0 D NO Q
40 I '% W !?3,"Enter 'Y'es to edit the above date, otherwise 'N'o" G YN
41 ;
42CHOOSE ;choose line to edit
43 R !!,"Choose a line (1-9): ",X:DTIME I '$T D NO Q
44 I X["^" G EDIT
45 I X<1!(X>9) W !?3,"Enter the numbers of the lines to edit separated by commas (ex. 1,2,3)" G CHOOSE
46 ;
47 W !!?5,"WARNING: You must enter the entire line(s) again",!
48 F DGLN=1:1 S K=$P(X,",",DGLN) Q:'K S DGLINE(K)="" D FT Q:DGFL
49 I DGFL=2 D NO Q
50 G EDIT
51 ;
52 ;
53PEND ;print data cards on hold
54 K DIC S DIC("A")="Print Pending Cards for which Card Type: ",DIC="^DIC(39.1,",DIC(0)="AEQM" D ^DIC K DIC I Y<1 G PENDQ
55 S DGTYP=+Y,DGX=^DIC(39.1,DGTYP,0) I '$O(^DIC(39.1,DGTYP,"HOLD",0)) W !!?3,"There are no ",$P(DGX,"^",1)," cards on hold to be printed",! G PEND
56 S ZTRTN="BATCH^DGQEMP",ZTSAVE("DGTYP")="",ZTDESC="Print Data Cards on Hold"
57 D QUEUE
58 G PEND
59PENDQ D END^DGQEMA Q
60 ;
61 ;
62NO ;no data card queued
63 W !,*7,"Data card NOT queued"
64 Q
65 ;
66 ;
67FREE ;Print free text data card
68 S DFN="",S=$O(^DIC(39.1,"C",9,0)) I '$D(^DIC(39.1,+S,0)) G FREEQ
69 S DGX=^(0),DGTYP=$P(DGX,"^",6) I 'DGTYP G FREEQ
70 S DGHD=0
71 F K=1:1:9 D FT Q:DGFL
72 I DGFL=2 W !,*7,"Data card NOT queued" Q
73 D EDIT
74FREEQ D END^DGQEMA K DFN,DGMANFL
75 Q
76 ;
77 ;
78FT S DGFL=0 W !,"Free Text line ",K,": " R Y:DTIME S:'$T DGFL=2 S:Y="^" DGFL=1 I DGFL Q
79 I Y["?" W !,?4,"You may enter a free text comment for this line on the Patient card." G FT
80 I $L(Y)>26 W !,?4,"Text must be less than 27 characters." G FT
81 I (Y["#")!(Y["@")!(Y["""")!(Y?.E1L.E) W !,?2,"Lower case characters and the following symbols: (#),(@),("") are not allowed." G FT
82 S DGLINE(K)=Y
83 Q
84 ;
85 ;
86ERROR ;Error messages for incomplete data
87 I $S('$D(^DPT(DFN,.36)):1,'^(.36):1,1:0) S DGE=1 S Y="ELIGIBILITY CODE" D ERR
88 I S=3 G NV
89 I $S('$D(^DPT(DFN,.32)):1,'$P(^(.32),"^",3):1,1:0) S Y="PERIOD OF SERVICE" D ERR
90 I $S('$D(^DPT(DFN,.31)):1,$P(^(.31),"^",3)']"":1,1:0) S Y="CLAIM NUMBER" D ERR
91NV S X=^DPT(DFN,0) F I=1,2,3,5,8,9 I $P(X,"^",I)="" S Y=$P(^DD(2,".0"_I,0),"^",1) D ERR
92 I $D(^DPT(DFN,.11)) S X=^DPT(DFN,.11) F I=1,4,5,6,7 I $P(X,"^",I)="" S Y=$P(^DD(2,".11"_I,0),"^",1) D ERR
93 I '$D(^DPT(DFN,.11)) S DGE=1 S Y="ADDRESS DATA" D ERR Q
94 Q
95ERR W !,Y," MISSING" S DGE=1 Q
Note: See TracBrowser for help on using the repository browser.