| 1 | VAQUTL93 ;ALB/JFP,JRP - UTILITY ROUTINES; 01-APR-93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**7**;NOV 17, 1993
|
---|
| 3 | EP ; -- Entry point for report
|
---|
| 4 | F SEG="MIN","MAS","ELIG","DENTAL","APPOINT","INSURE" D EXTR
|
---|
| 5 | QUIT
|
---|
| 6 | ;
|
---|
| 7 | EXTR ;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 | ;
|
---|
| 38 | ADDEDT ;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
|
---|
| 67 | INPUT(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
|
---|