ADEDDTH ; IHS/HQT/MJL - IHS-RPMS/MLQ ADD/EDIT GENERIC PROVIDER FILE ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
;THIS ROUTINE EDITS THE GENERIC PROVIDER FILE ACCORDING TO THE
;FIELD NAMES AND ENTRY ORDER STORED IN THE GENERIC PARAMETER FILE
;
D ^XBKVAR
;FHL 9/9/98 S:'$D(DTIME) DTIME=300
;FHL 9/9/98 S:DTIME="" DTIME=300
;FHL 9/9/98
S DTIME=$$DTIME^XUP(DUZ)
;VARIABLES ADEPRVFN & ADEPRMFN SET IN KERNEL OPTION PRIOR TO EXECUTION ***
I '$D(ADEPRVFN) S XQUIT=1 W !,"YOUR DISCIPLINE'S GENERIC PROVIDER FILE NUMBER IS NOT BEING SET IN THE KERNEL OPTION. SEE YOUR SITE MANAGER." Q
I '$D(ADEPRMFN) S XQUIT=1 W !,"YOUR DISCIPLINE'S GENERIC PARAMETER FILE NUMBER IS NOT BEING SET IN THE KERNEL OPTION. SEE YOUR SITE MANAGER." Q
S ADEPRVGN=^DIC(ADEPRVFN,0,"GL") ;PROVIDER FILE & GLOBAL
S ADEPRMGN=^DIC(ADEPRMFN,0,"GL") ;PARAMETER FILE & GLOBAL
SEO ;STORE SUBROUTINE NAMES IN ENTRY ORDER
S ADESUBNM(1)="PROV",ADESUBNM(2)="FACL",ADESUBNM(3)="SERU",ADESUBNM(4)="TRBE"
SETA ;DISCIPLINE SPECIFIED FIELD ENTRY ORDER
S ADEFEO=ADEPRMGN_"1,""PEO"")"
I '$D(@ADEFEO) S ADEFEO="1^2^^3" G SETB
I @ADEFEO["1"!("2")!("3")!("4") S ADEFEO=@ADEFEO I 1
E S ADEFEO="1^2^^3^"
SETB ;DISCIPLINE SPECIFIED FIELD NAMES
S ADEFNM=ADEPRMGN_"1,""EQN"")"
I '$D(@ADEFNM) S ADEFNM="" G SETAI
S ADEFNM=@ADEFNM
SETAI ;
F ADEI=1:1:4 S ADEAI=$P(ADEFEO,"^",ADEI) S:ADEAI'="" ADESUBRT(ADEAI)=ADESUBNM(ADEI),ADEFLDNM(ADEAI)=$P(ADEFNM,"^",ADEI)
LOOP ;
S ADEA="" K ADEPROV
F ADEI=0:0 S ADEA=$O(ADESUBRT(ADEA)) Q:ADEA="" D @ADESUBRT(ADEA)
G:X="^" KVAR
F ADEI=1:1:4 S:'$D(ADEPROV(ADEI)) ADEPROV(ADEI)="/@"
D ^ADEDDTH1
S %=2 W !,"ADD/EDIT ANOTHER RECORD" D YN^DICN
I %=1 G LOOP
D KVAR
Q
K ADEFEO
;
;ADEDDENT CONTAINS DD ENTRY FOR A SPECIFIC FIELD
;^1 = FIELD NAME
;^2 = REQUIRED
;^3 = POINTED TO FILE
;^4 = GLOBAL LOCATION
;^5 = INPUT TRANSFORM
PROV ;EDIT PROVIDER ^DIC(6,
S ADEDDENT=^DD(ADEPRVFN,.01,0) D SDDIC
Q
FACL ;EDIT FACILITY, FORCE SERU ^AUTTLOC
S ADEDDENT=^DD(ADEPRVFN,2,0) D SDDIC
S ADEPROV(2)=$P(Y(0),"^",5)
Q
SERU ;EDIT SERVICE UNIT ^AUTTSU
S ADEDDENT=^DD(ADEPRVFN,1,0) D SDDIC
Q
TRBE ;EDIT TRIBE ^AUTTTRI
S ADEDDENT=^DD(ADEPRVFN,3,0) D SDDIC
Q
SDDIC ;GET DD INFO, D ^DIC FOR PTR FIELDS
S:ADEFLDNM(ADEA)="" ADEFLDNM(ADEA)=$P(ADEDDENT,"^")
S DIC("A")=ADEFLDNM(ADEA)_": "
S DIC="^"_$P(ADEDDENT,"^",3),DIC(0)="AEMQZ" D ^DIC
I X="^",ADEA=1 W !,"EXITING ROUTINE" S ADEA="ZZZZZ" G KVAR
I Y<1 I $P(ADEDDENT,"^",2)["R" W !,$C(7),ADEFLDNM(ADEA)," IS REQUIRED" G SDDIC
Q:Y<1
S ADEGL=$P($P(ADEDDENT,"^",4),";",2)
I ADEGL=1 S ADEPROV(ADEGL)=$P(Y(0,0),"^")
E S ADEPROV(ADEGL)=$P(Y,"^")
Q
KVAR ;KILL VARIABLES
K ADESUBRT,ADESUBNM,ADEFLDNM,ADEPROV ; SUBSCRIPTED VARIABLES
K ADEA,ADEAI,ADEDDENT,ADEPRMFN,ADEPRMGN,ADEPRVFN,ADEPRVGN,ADEFNM,DIC,DIC(0),DIC("A")
K ADEGL,ADEI,X,Y,Y(0),Y(0,0)
Q
ADEDDTH ; IHS/HQT/MJL - IHS-RPMS/MLQ ADD/EDIT GENERIC PROVIDER FILE ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 ;THIS ROUTINE EDITS THE GENERIC PROVIDER FILE ACCORDING TO THE
+3 ;FIELD NAMES AND ENTRY ORDER STORED IN THE GENERIC PARAMETER FILE
+4 ;
+5 DO ^XBKVAR
+6 ;FHL 9/9/98 S:'$D(DTIME) DTIME=300
+7 ;FHL 9/9/98 S:DTIME="" DTIME=300
+8 ;FHL 9/9/98
+9 SET DTIME=$$DTIME^XUP(DUZ)
+10 ;VARIABLES ADEPRVFN & ADEPRMFN SET IN KERNEL OPTION PRIOR TO EXECUTION ***
+11 IF '$DATA(ADEPRVFN)
SET XQUIT=1
WRITE !,"YOUR DISCIPLINE'S GENERIC PROVIDER FILE NUMBER IS NOT BEING SET IN THE KERNEL OPTION. SEE YOUR SITE MANAGER."
QUIT
+12 IF '$DATA(ADEPRMFN)
SET XQUIT=1
WRITE !,"YOUR DISCIPLINE'S GENERIC PARAMETER FILE NUMBER IS NOT BEING SET IN THE KERNEL OPTION. SEE YOUR SITE MANAGER."
QUIT
+13 ;PROVIDER FILE & GLOBAL
SET ADEPRVGN=^DIC(ADEPRVFN,0,"GL")
+14 ;PARAMETER FILE & GLOBAL
SET ADEPRMGN=^DIC(ADEPRMFN,0,"GL")
SEO ;STORE SUBROUTINE NAMES IN ENTRY ORDER
+1 SET ADESUBNM(1)="PROV"
SET ADESUBNM(2)="FACL"
SET ADESUBNM(3)="SERU"
SET ADESUBNM(4)="TRBE"
SETA ;DISCIPLINE SPECIFIED FIELD ENTRY ORDER
+1 SET ADEFEO=ADEPRMGN_"1,""PEO"")"
+2 IF '$DATA(@ADEFEO)
SET ADEFEO="1^2^^3"
GOTO SETB
+3 IF @ADEFEO["1"!("2")!("3")!("4")
SET ADEFEO=@ADEFEO
IF 1
+4 IF '$TEST
SET ADEFEO="1^2^^3^"
SETB ;DISCIPLINE SPECIFIED FIELD NAMES
+1 SET ADEFNM=ADEPRMGN_"1,""EQN"")"
+2 IF '$DATA(@ADEFNM)
SET ADEFNM=""
GOTO SETAI
+3 SET ADEFNM=@ADEFNM
SETAI ;
+1 FOR ADEI=1:1:4
SET ADEAI=$PIECE(ADEFEO,"^",ADEI)
IF ADEAI'=""
SET ADESUBRT(ADEAI)=ADESUBNM(ADEI)
SET ADEFLDNM(ADEAI)=$PIECE(ADEFNM,"^",ADEI)
LOOP ;
+1 SET ADEA=""
KILL ADEPROV
+2 FOR ADEI=0:0
SET ADEA=$ORDER(ADESUBRT(ADEA))
IF ADEA=""
QUIT
DO @ADESUBRT(ADEA)
+3 IF X="^"
GOTO KVAR
+4 FOR ADEI=1:1:4
IF '$DATA(ADEPROV(ADEI))
SET ADEPROV(ADEI)="/@"
+5 DO ^ADEDDTH1
+6 SET %=2
WRITE !,"ADD/EDIT ANOTHER RECORD"
DO YN^DICN
+7 IF %=1
GOTO LOOP
+8 DO KVAR
+9 QUIT
+10 KILL ADEFEO
+11 ;
+12 ;ADEDDENT CONTAINS DD ENTRY FOR A SPECIFIC FIELD
+13 ;^1 = FIELD NAME
+14 ;^2 = REQUIRED
+15 ;^3 = POINTED TO FILE
+16 ;^4 = GLOBAL LOCATION
+17 ;^5 = INPUT TRANSFORM
PROV ;EDIT PROVIDER ^DIC(6,
+1 SET ADEDDENT=^DD(ADEPRVFN,.01,0)
DO SDDIC
+2 QUIT
FACL ;EDIT FACILITY, FORCE SERU ^AUTTLOC
+1 SET ADEDDENT=^DD(ADEPRVFN,2,0)
DO SDDIC
+2 SET ADEPROV(2)=$PIECE(Y(0),"^",5)
+3 QUIT
SERU ;EDIT SERVICE UNIT ^AUTTSU
+1 SET ADEDDENT=^DD(ADEPRVFN,1,0)
DO SDDIC
+2 QUIT
TRBE ;EDIT TRIBE ^AUTTTRI
+1 SET ADEDDENT=^DD(ADEPRVFN,3,0)
DO SDDIC
+2 QUIT
SDDIC ;GET DD INFO, D ^DIC FOR PTR FIELDS
+1 IF ADEFLDNM(ADEA)=""
SET ADEFLDNM(ADEA)=$PIECE(ADEDDENT,"^")
+2 SET DIC("A")=ADEFLDNM(ADEA)_": "
+3 SET DIC="^"_$PIECE(ADEDDENT,"^",3)
SET DIC(0)="AEMQZ"
DO ^DIC
+4 IF X="^"
IF ADEA=1
WRITE !,"EXITING ROUTINE"
SET ADEA="ZZZZZ"
GOTO KVAR
+5 IF Y<1
IF $PIECE(ADEDDENT,"^",2)["R"
WRITE !,$CHAR(7),ADEFLDNM(ADEA)," IS REQUIRED"
GOTO SDDIC
+6 IF Y<1
QUIT
+7 SET ADEGL=$PIECE($PIECE(ADEDDENT,"^",4),";",2)
+8 IF ADEGL=1
SET ADEPROV(ADEGL)=$PIECE(Y(0,0),"^")
+9 IF '$TEST
SET ADEPROV(ADEGL)=$PIECE(Y,"^")
+10 QUIT
KVAR ;KILL VARIABLES
+1 ; SUBSCRIPTED VARIABLES
KILL ADESUBRT,ADESUBNM,ADEFLDNM,ADEPROV
+2 KILL ADEA,ADEAI,ADEDDENT,ADEPRMFN,ADEPRMGN,ADEPRVFN,ADEPRVGN,ADEFNM,DIC,DIC(0),DIC("A")
+3 KILL ADEGL,ADEI,X,Y,Y(0),Y(0,0)
+4 QUIT
