VAQUTL93 ;ALB/JFP,JRP - UTILITY ROUTINES; 01-APR-93
;;1.5;PATIENT DATA EXCHANGE;**7**;NOV 17, 1993
EP ; -- Entry point for report
F SEG="MIN","MAS","ELIG","DENTAL","APPOINT","INSURE" D EXTR
QUIT
;
EXTR ;EXTRACT INFORMATION
W !,"[ ",SEG," ]",!
W !,?5,"FILE NO.",?25,"FIELD NO",?35,"NODE;PIECE",?48,"DESCRIPT",!
S (FLENO,ERROR)=0
F LOOP=1:1 D Q:(ERROR)
.S OLDFLE=FLENO
.S TMP=$T(@SEG+LOOP^VAQDBII1)
.I ($P(TMP,";;",2)="") S ERROR=1 Q
.S FLENO=$P(TMP,";",3)
.S FIELDS=$P(TMP,";",4)
.I OLDFLE'=FLENO S FLEREF=FLENO W ! ;$G(^DIC(FLENO,0,"GL"))
.I OLDFLE=FLENO S FLEREF=" "
.F LP=1:1 D Q:FLD=""
..S FLD=$P(FIELDS,",",LP) Q:FLD=""
..S DDNODE=$G(^DD(FLENO,FLD,0))
..S FLDDS=$P(DDNODE,U,1)
..S FLDLC=$P(DDNODE,U,4)
..W !,?5,FLEREF,?25,FLD,?35,FLDLC,?48,FLDDS
..S FLEREF=" "
QUIT
;
;EXTRACT OTHER ELIGIBILITIES
D ELIG^VAQDBIP6
;EXTRACT APPOINTMENTS
D APPOINT^VAQDBIP6
;EXTRACT DENTAL APPOINTMENTS
D DENTAL^VAQDBIP6
;EXTRACT ACTIVE INSURANCES
D INSURE^VAQDBIP7
QUIT
;
ADDEDT ;TAG FOR ADD/EDIT OPTIONS
;INPUT : VAQOFLG - Number indicating which option is calling tag
; 1 = VAQ (EDIT) ENCRY FIELDS
; 2 = VAQ (EDIT) PARAMETER
; 3 = VAQ (EDIT) RELEASE GROUP
; 4 = VAQ (EDIT) OUTGOING GROUP
; 5 = VAQ (EDIT) SEGMENT GRP - ALL
; 6 = VAQ (EDIT) SEGMENT GRP - PRIV
; 7 = VAQ (EDIT) SEGMENT GRP - PUBL
; 8 = VAQ (EDIT) MAX LIMITS
;OUTPUT : None
;
S VAQOFLG=+$G(VAQOFLG)
Q:((VAQOFLG<1)!(VAQOFLG>8))
;DECLARE VARIABLES
N FNUM,TMPLT,SCRN,DELADD
S TMPLT="[VAQ EDIT FILE]"
S SCRN=""
S DELADD=3
S:(VAQOFLG=1) FNUM=394.73
S:(VAQOFLG=2) FNUM=394.81
S:(VAQOFLG=3) FNUM=394.82
S:(VAQOFLG=4) FNUM=394.83
S:(VAQOFLG=5) FNUM=394.84
S:(VAQOFLG=6) FNUM=394.84,TMPLT="[VAQ EDIT FILE (PRIVATE)]",SCRN="I (($P(^(0),U,2)'=1)&($P(^(0),U,3)=$G(DUZ)))"
S:(VAQOFLG=7) FNUM=394.84,TMPLT="[VAQ EDIT FILE (PUBLIC)]",SCRN="I $P(^(0),U,2)=1"
S:(VAQOFLG=8) FNUM=394.71,DELADD=0
D INPUT(FNUM,TMPLT,SCRN,DELADD)
Q
INPUT(FILENUM,TEMPLATE,SCREEN,ADDEL) ;ADD/EDIT ENTRIES IN FILES USING INPUT TEMPLATE
;INPUT : FILE - File number
; TEMPLATE - Name of input template (with brackets)
; SCREEN - Optional screen to use during lookup
; ADDEL - Code indicating if add/delete override is allowed
; 0 = Don't override add/delete protection (default)
; 1 = Override add protection only
; 2 = Override delete protection only
; 3 = Override add & delete protection
;OUTPUT : None
;NOTE : All input is assumed to be in correct format
; (Existance of variables is the only thing checked)
;
Q:('$G(FILENUM))
Q:($G(TEMPLATE)="")
S SCREEN=$G(SCREEN)
S ADDEL=+$G(ADDEL)
;INITIALIZE VARIABLES
N DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIE,DA,DR,DIDEL,STOP
;CONTINUOUS LOOP
S STOP=0
F D Q:(STOP)
.;ADD/FIND ENTRY
.K DIC,DLAYGO,X
.S DIC=FILENUM
.S DIC(0)="AEMQ"
.S DIC("DR")=TEMPLATE
.S:(SCREEN'="") DIC("S")=SCREEN
.S:((ADDEL=1)!(ADDEL=3)) DLAYGO=FILENUM,DIC(0)="AEMQL"
.D ^DIC
.;CHECK FOR ABORT
.I ($D(DTOUT)!$D(DUOUT)!(Y<0)) S STOP=1 Q
.;ENTRY ADDED
.Q:(+$P(Y,"^",3))
.;EDIT ENTRY
.K DIE,DA,DR,DIDEL
.S DIE=FILENUM
.S DA=+Y
.S DR=TEMPLATE
.S:((ADDEL=2)!(ADDEL=3)) DIDEL=FILENUM
.D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUTL93 3377 printed Nov 22, 2024@17:37:04 Page 2
VAQUTL93 ;ALB/JFP,JRP - UTILITY ROUTINES; 01-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**7**;NOV 17, 1993
EP ; -- Entry point for report
+1 FOR SEG="MIN","MAS","ELIG","DENTAL","APPOINT","INSURE"
DO EXTR
+2 QUIT
+3 ;
EXTR ;EXTRACT INFORMATION
+1 WRITE !,"[ ",SEG," ]",!
+2 WRITE !,?5,"FILE NO.",?25,"FIELD NO",?35,"NODE;PIECE",?48,"DESCRIPT",!
+3 SET (FLENO,ERROR)=0
+4 FOR LOOP=1:1
Begin DoDot:1
+5 SET OLDFLE=FLENO
+6 SET TMP=$TEXT(@SEG+LOOP^VAQDBII1)
+7 IF ($PIECE(TMP,";;",2)="")
SET ERROR=1
QUIT
+8 SET FLENO=$PIECE(TMP,";",3)
+9 SET FIELDS=$PIECE(TMP,";",4)
+10 ;$G(^DIC(FLENO,0,"GL"))
IF OLDFLE'=FLENO
SET FLEREF=FLENO
WRITE !
+11 IF OLDFLE=FLENO
SET FLEREF=" "
+12 FOR LP=1:1
Begin DoDot:2
+13 SET FLD=$PIECE(FIELDS,",",LP)
if FLD=""
QUIT
+14 SET DDNODE=$GET(^DD(FLENO,FLD,0))
+15 SET FLDDS=$PIECE(DDNODE,U,1)
+16 SET FLDLC=$PIECE(DDNODE,U,4)
+17 WRITE !,?5,FLEREF,?25,FLD,?35,FLDLC,?48,FLDDS
+18 SET FLEREF=" "
End DoDot:2
if FLD=""
QUIT
End DoDot:1
if (ERROR)
QUIT
+19 QUIT
+20 ;
+21 ;EXTRACT OTHER ELIGIBILITIES
+22 DO ELIG^VAQDBIP6
+23 ;EXTRACT APPOINTMENTS
+24 DO APPOINT^VAQDBIP6
+25 ;EXTRACT DENTAL APPOINTMENTS
+26 DO DENTAL^VAQDBIP6
+27 ;EXTRACT ACTIVE INSURANCES
+28 DO INSURE^VAQDBIP7
+29 QUIT
+30 ;
ADDEDT ;TAG FOR ADD/EDIT OPTIONS
+1 ;INPUT : VAQOFLG - Number indicating which option is calling tag
+2 ; 1 = VAQ (EDIT) ENCRY FIELDS
+3 ; 2 = VAQ (EDIT) PARAMETER
+4 ; 3 = VAQ (EDIT) RELEASE GROUP
+5 ; 4 = VAQ (EDIT) OUTGOING GROUP
+6 ; 5 = VAQ (EDIT) SEGMENT GRP - ALL
+7 ; 6 = VAQ (EDIT) SEGMENT GRP - PRIV
+8 ; 7 = VAQ (EDIT) SEGMENT GRP - PUBL
+9 ; 8 = VAQ (EDIT) MAX LIMITS
+10 ;OUTPUT : None
+11 ;
+12 SET VAQOFLG=+$GET(VAQOFLG)
+13 if ((VAQOFLG<1)!(VAQOFLG>8))
QUIT
+14 ;DECLARE VARIABLES
+15 NEW FNUM,TMPLT,SCRN,DELADD
+16 SET TMPLT="[VAQ EDIT FILE]"
+17 SET SCRN=""
+18 SET DELADD=3
+19 if (VAQOFLG=1)
SET FNUM=394.73
+20 if (VAQOFLG=2)
SET FNUM=394.81
+21 if (VAQOFLG=3)
SET FNUM=394.82
+22 if (VAQOFLG=4)
SET FNUM=394.83
+23 if (VAQOFLG=5)
SET FNUM=394.84
+24 if (VAQOFLG=6)
SET FNUM=394.84
SET TMPLT="[VAQ EDIT FILE (PRIVATE)]"
SET SCRN="I (($P(^(0),U,2)'=1)&($P(^(0),U,3)=$G(DUZ)))"
+25 if (VAQOFLG=7)
SET FNUM=394.84
SET TMPLT="[VAQ EDIT FILE (PUBLIC)]"
SET SCRN="I $P(^(0),U,2)=1"
+26 if (VAQOFLG=8)
SET FNUM=394.71
SET DELADD=0
+27 DO INPUT(FNUM,TMPLT,SCRN,DELADD)
+28 QUIT
INPUT(FILENUM,TEMPLATE,SCREEN,ADDEL) ;ADD/EDIT ENTRIES IN FILES USING INPUT TEMPLATE
+1 ;INPUT : FILE - File number
+2 ; TEMPLATE - Name of input template (with brackets)
+3 ; SCREEN - Optional screen to use during lookup
+4 ; ADDEL - Code indicating if add/delete override is allowed
+5 ; 0 = Don't override add/delete protection (default)
+6 ; 1 = Override add protection only
+7 ; 2 = Override delete protection only
+8 ; 3 = Override add & delete protection
+9 ;OUTPUT : None
+10 ;NOTE : All input is assumed to be in correct format
+11 ; (Existance of variables is the only thing checked)
+12 ;
+13 if ('$GET(FILENUM))
QUIT
+14 if ($GET(TEMPLATE)="")
QUIT
+15 SET SCREEN=$GET(SCREEN)
+16 SET ADDEL=+$GET(ADDEL)
+17 ;INITIALIZE VARIABLES
+18 NEW DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIE,DA,DR,DIDEL,STOP
+19 ;CONTINUOUS LOOP
+20 SET STOP=0
+21 FOR
Begin DoDot:1
+22 ;ADD/FIND ENTRY
+23 KILL DIC,DLAYGO,X
+24 SET DIC=FILENUM
+25 SET DIC(0)="AEMQ"
+26 SET DIC("DR")=TEMPLATE
+27 if (SCREEN'="")
SET DIC("S")=SCREEN
+28 if ((ADDEL=1)!(ADDEL=3))
SET DLAYGO=FILENUM
SET DIC(0)="AEMQL"
+29 DO ^DIC
+30 ;CHECK FOR ABORT
+31 IF ($DATA(DTOUT)!$DATA(DUOUT)!(Y<0))
SET STOP=1
QUIT
+32 ;ENTRY ADDED
+33 if (+$PIECE(Y,"^",3))
QUIT
+34 ;EDIT ENTRY
+35 KILL DIE,DA,DR,DIDEL
+36 SET DIE=FILENUM
+37 SET DA=+Y
+38 SET DR=TEMPLATE
+39 if ((ADDEL=2)!(ADDEL=3))
SET DIDEL=FILENUM
+40 DO ^DIE
End DoDot:1
if (STOP)
QUIT
+41 QUIT
