source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUTL93.m@ 674

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1VAQUTL93 ;ALB/JFP,JRP - UTILITY ROUTINES; 01-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;**7**;NOV 17, 1993
3EP ; -- Entry point for report
4 F SEG="MIN","MAS","ELIG","DENTAL","APPOINT","INSURE" D EXTR
5 QUIT
6 ;
7EXTR ;EXTRACT INFORMATION
8 W !,"[ ",SEG," ]",!
9 W !,?5,"FILE NO.",?25,"FIELD NO",?35,"NODE;PIECE",?48,"DESCRIPT",!
10 S (FLENO,ERROR)=0
11 F LOOP=1:1 D Q:(ERROR)
12 .S OLDFLE=FLENO
13 .S TMP=$T(@SEG+LOOP^VAQDBII1)
14 .I ($P(TMP,";;",2)="") S ERROR=1 Q
15 .S FLENO=$P(TMP,";",3)
16 .S FIELDS=$P(TMP,";",4)
17 .I OLDFLE'=FLENO S FLEREF=FLENO W ! ;$G(^DIC(FLENO,0,"GL"))
18 .I OLDFLE=FLENO S FLEREF=" "
19 .F LP=1:1 D Q:FLD=""
20 ..S FLD=$P(FIELDS,",",LP) Q:FLD=""
21 ..S DDNODE=$G(^DD(FLENO,FLD,0))
22 ..S FLDDS=$P(DDNODE,U,1)
23 ..S FLDLC=$P(DDNODE,U,4)
24 ..W !,?5,FLEREF,?25,FLD,?35,FLDLC,?48,FLDDS
25 ..S FLEREF=" "
26 QUIT
27 ;
28 ;EXTRACT OTHER ELIGIBILITIES
29 D ELIG^VAQDBIP6
30 ;EXTRACT APPOINTMENTS
31 D APPOINT^VAQDBIP6
32 ;EXTRACT DENTAL APPOINTMENTS
33 D DENTAL^VAQDBIP6
34 ;EXTRACT ACTIVE INSURANCES
35 D INSURE^VAQDBIP7
36 QUIT
37 ;
38ADDEDT ;TAG FOR ADD/EDIT OPTIONS
39 ;INPUT : VAQOFLG - Number indicating which option is calling tag
40 ; 1 = VAQ (EDIT) ENCRY FIELDS
41 ; 2 = VAQ (EDIT) PARAMETER
42 ; 3 = VAQ (EDIT) RELEASE GROUP
43 ; 4 = VAQ (EDIT) OUTGOING GROUP
44 ; 5 = VAQ (EDIT) SEGMENT GRP - ALL
45 ; 6 = VAQ (EDIT) SEGMENT GRP - PRIV
46 ; 7 = VAQ (EDIT) SEGMENT GRP - PUBL
47 ; 8 = VAQ (EDIT) MAX LIMITS
48 ;OUTPUT : None
49 ;
50 S VAQOFLG=+$G(VAQOFLG)
51 Q:((VAQOFLG<1)!(VAQOFLG>8))
52 ;DECLARE VARIABLES
53 N FNUM,TMPLT,SCRN,DELADD
54 S TMPLT="[VAQ EDIT FILE]"
55 S SCRN=""
56 S DELADD=3
57 S:(VAQOFLG=1) FNUM=394.73
58 S:(VAQOFLG=2) FNUM=394.81
59 S:(VAQOFLG=3) FNUM=394.82
60 S:(VAQOFLG=4) FNUM=394.83
61 S:(VAQOFLG=5) FNUM=394.84
62 S:(VAQOFLG=6) FNUM=394.84,TMPLT="[VAQ EDIT FILE (PRIVATE)]",SCRN="I (($P(^(0),U,2)'=1)&($P(^(0),U,3)=$G(DUZ)))"
63 S:(VAQOFLG=7) FNUM=394.84,TMPLT="[VAQ EDIT FILE (PUBLIC)]",SCRN="I $P(^(0),U,2)=1"
64 S:(VAQOFLG=8) FNUM=394.71,DELADD=0
65 D INPUT(FNUM,TMPLT,SCRN,DELADD)
66 Q
67INPUT(FILENUM,TEMPLATE,SCREEN,ADDEL) ;ADD/EDIT ENTRIES IN FILES USING INPUT TEMPLATE
68 ;INPUT : FILE - File number
69 ; TEMPLATE - Name of input template (with brackets)
70 ; SCREEN - Optional screen to use during lookup
71 ; ADDEL - Code indicating if add/delete override is allowed
72 ; 0 = Don't override add/delete protection (default)
73 ; 1 = Override add protection only
74 ; 2 = Override delete protection only
75 ; 3 = Override add & delete protection
76 ;OUTPUT : None
77 ;NOTE : All input is assumed to be in correct format
78 ; (Existance of variables is the only thing checked)
79 ;
80 Q:('$G(FILENUM))
81 Q:($G(TEMPLATE)="")
82 S SCREEN=$G(SCREEN)
83 S ADDEL=+$G(ADDEL)
84 ;INITIALIZE VARIABLES
85 N DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIE,DA,DR,DIDEL,STOP
86 ;CONTINUOUS LOOP
87 S STOP=0
88 F D Q:(STOP)
89 .;ADD/FIND ENTRY
90 .K DIC,DLAYGO,X
91 .S DIC=FILENUM
92 .S DIC(0)="AEMQ"
93 .S DIC("DR")=TEMPLATE
94 .S:(SCREEN'="") DIC("S")=SCREEN
95 .S:((ADDEL=1)!(ADDEL=3)) DLAYGO=FILENUM,DIC(0)="AEMQL"
96 .D ^DIC
97 .;CHECK FOR ABORT
98 .I ($D(DTOUT)!$D(DUOUT)!(Y<0)) S STOP=1 Q
99 .;ENTRY ADDED
100 .Q:(+$P(Y,"^",3))
101 .;EDIT ENTRY
102 .K DIE,DA,DR,DIDEL
103 .S DIE=FILENUM
104 .S DA=+Y
105 .S DR=TEMPLATE
106 .S:((ADDEL=2)!(ADDEL=3)) DIDEL=FILENUM
107 .D ^DIE
108 Q
Note: See TracBrowser for help on using the repository browser.