EASEZU1 ;ALB/jap,LBD - Utilities for 1010EZ Processing ; 9/19/12 11:28am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**107**;Mar 15, 2001;Build 32
;
KEY711(EASKEY) ;get file #711 record associated with key
;input EASKEY = character string equal to a 1010EZ Assigned Data Name OR Data Key
;output KEYIEN = pointer to file #711 for the 1010EZ data element is 1st piece;
; format: ien^Assigned Data Name^Data Key
; returns ".1" if EASKEY is invalid, i.e., data element is unknown
;
N N,KEYIEN,X,XX,Y,DA,DIE,DR
S KEYIEN=""
;key passed in is Data Key
I EASKEY[".",EASKEY[";" D
.S KEYIEN=$O(^EAS(711,"C",EASKEY,0)) Q:'KEYIEN
.S X=$P(^EAS(711,KEYIEN,0),U,1)
.S KEYIEN=KEYIEN_U_X_U_EASKEY
;key passed in is Assigned Data Name
I KEYIEN="" D
.I $L(EASKEY)>50 D
..;Fix problem when data passed in EASKEY is > 50 chars. (EAS*1*107)
..S EASKEY=$E(EASKEY,1,50)
..I $E(EASKEY,50)=" " S EASKEY=$E(EASKEY,1,49)
.S KEYIEN=$O(^EAS(711,"AB",EASKEY,0)) Q:'KEYIEN
.S X=$P(^EAS(711,KEYIEN,0),U,2)
.S KEYIEN=KEYIEN_U_EASKEY_U_X
I KEYIEN="" S KEYIEN=".1"
Q KEYIEN
;
DATA712(EASAPP,EASKEY,EASMM) ;get 1010EZ data associated with data key
;input EASAPP = ien to #712 for Application
; EASKEY = IEN to file #711;
; OR KEYIEN returned by KEY711^EASEZU1
; EASMM = multiple number; default is 1; optional
; pertains to data elements that may be multiple,
; i.e., additional child dependents
;
;output RTR = piece 1 - 1010EZ data associated with Data Key for this Application;
; piece 2 - subrecord ien associated with Data Key for this Application;
; returns ^ if data item not found in this Application
;
N N,OUT,KEYIEN,MULTIPLE,X,RTR,IN,UP
I '$D(^EAS(712,EASAPP,0)) Q U
;this is the "unknown" data element
I EASKEY=.1 Q U
I '$G(EASMM) S EASMM=1
S KEYIEN=+EASKEY
S OUT=0,N=0,X="",RTR=U
F S N=$O(^EAS(712,EASAPP,10,"B",KEYIEN,N)) Q:'N D Q:OUT
.S MULTIPLE=$P($G(^EAS(712,EASAPP,10,N,0)),U,2)
.I MULTIPLE=EASMM D
..;use 'updated' data if present
..S X=$G(^EAS(712,EASAPP,10,N,1)),IN=$P(X,U,1),UP=$P(X,U,2)
..S RTR=$S(UP'="":UP,1:IN),RTR=RTR_U_N,OUT=1
Q RTR
;
LINKUP(EASAPP,EASAEL,EASLINK) ;place link into a file #712 Data Element subrecord
;input EASAPP = ien to #712 for Application
; EASAEL = ien to Data Elements subrecord in #712
; EASLINK = file ien OR file_ien;subfile_ien to link 1010EZ data
; with existing Patient database record
;exit if record/subrecord not valid in #712
N DA,DR,DIE,X,Y
Q:'EASAPP Q:'$D(^EAS(712,EASAPP,0))
Q:'EASAEL Q:'$D(^EAS(712,EASAPP,10,EASAEL,0))
;place link in Data Element subrecord of #712
S DA(1)=EASAPP,DA=EASAEL,DR(1)=10
S DIE="^EAS(712,EASAPP,10,"
S DR="2.1///^S X=EASLINK;"
D ^DIE
Q
;
ADD71201(EASAPP,KEYIEN,LINK,MULTIPLE) ;add another subrecord to #712.01
;used in cases where Patient data exists but 1010EZ data does not;
;this new subrecord will hold the VistA database ien(s)
;
;input EASAPP = ien to file #712
; KEYIEN = ien to file #711 for data element
; LINK = ien(s) in VistA database;
; format: ien_main_file;ien_subfile
; MULTIPLE = default is 1; (optional)
; currently only needed for additional child dependents
; associated with Section IIB of the form.
;output NEWIEN = ien to new subrecord in sibfile #712.01
N NEWIEN,LASTIEN,DA,DIC,DIE,DR,DLAYGO,DINUM,X,Y
Q:'KEYIEN
Q:LINK=""
S LASTIEN=$O(^EAS(712,EASAPP,10,9999),-1),NEWIEN=LASTIEN+1
;create subrecord
S DIC="^EAS(712,EASAPP,10,",DIC(0)="L",DLAYGO="",X=KEYIEN,DINUM=NEWIEN
S DA(1)=EASAPP,DIC("P")=$P(^DD(712,10,0),U,2)
K DD,DO D FILE^DICN
;file data element link
S DIE="^EAS(712,EASAPP,10,",DA=NEWIEN,DA(1)=EASAPP,DR(1)="10;"
S MULTIPLE=$G(MULTIPLE) S:'MULTIPLE MULTIPLE=1
S DR=".1///^S X=MULTIPLE;2.1///^S X=LINK;"
D ^DIE
Q
;
GETANY(EASAPP,EASDFN,EASAEL,EASKEY) ;get data from VistA database for any field related to 1010EZ
;input EASAPP = ien to #712 for Application
; EASDFN = ien to #2 for Applicant
; either EASAEL or EASKEY must be non-null
; EASAEL = ien to Data Elements subrecord in #712; optional
; EASKEY = data key from Data Elements subrecord in #712; optional
;
;output RTR = data obtained from Patient database; external format
; OR -1 if invalid input
;
;the "link" below is a pointer (ien) to file or subfile record that
; was previously found to contain data which potentially matches
; 1010EZ data
;
N X,LINK,N,FILE,SUBFILE,FIELD,ARRAY,DIQ,DA,DR,DIC,RTR
S EASKEY=$G(EASKEY),N=0
I 'EASAEL,EASKEY="" Q -1
I 'EASAEL,EASKEY'="" D
.S EASAEL=$P($$DATA712(EASAPP,EASKEY),U,2) Q:'EASAEL
.S N=$O(^EAS(711,"C",EASKEY,0))
I EASKEY="",EASAEL S N=$P($G(^EAS(712,EASAPP,10,EASAEL,0)),U,1)
I 'N Q -1
;database parameters in #711
S X=$G(^EAS(711,N,1)),FILE=$P(X,U,1),SUBFILE=$P(X,U,2),FIELD=$P(X,U,3)
;get link ien if other than file #2
S LINK=$P($G(^EAS(712,EASAPP,10,EASAEL,2)),U,2)
;if data location is main file #2, then link is dfn
I FILE=2,(SUBFILE=2!SUBFILE="") S LINK=EASDFN
;
;if no link to database, quit
I 'LINK Q -1
;otherwise setup FM call & use link to get data
I (SUBFILE="")!(SUBFILE=FILE) D
.;data in main file
.S DIQ="ARRAY",DIQ(0)="E",DA=LINK,DR=FIELD,DIC=FILE
.D EN^DIQ1
.S RTR=$G(ARRAY(FILE,LINK,FIELD,"E"))
I SUBFILE'="",SUBFILE'=FILE D
.;data in subfile
.;in this case LINK = file_ien;subfile_ien
.S DIQ="ARRAY",DIQ(0)="E",DA=$P(LINK,";",1),DIC=FILE
.;get field # for subfile
.S DR=$O(^DD(FILE,"SB",SUBFILE,0))
.S DR(SUBFILE)=FIELD,DA(SUBFILE)=$P(LINK,";",2)
.D EN^DIQ1
.S RTR=$G(ARRAY(SUBFILE,$P(LINK,";",2),FIELD,"E"))
Q RTR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZU1 5905 printed Dec 13, 2024@01:55:12 Page 2
EASEZU1 ;ALB/jap,LBD - Utilities for 1010EZ Processing ; 9/19/12 11:28am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**107**;Mar 15, 2001;Build 32
+2 ;
KEY711(EASKEY) ;get file #711 record associated with key
+1 ;input EASKEY = character string equal to a 1010EZ Assigned Data Name OR Data Key
+2 ;output KEYIEN = pointer to file #711 for the 1010EZ data element is 1st piece;
+3 ; format: ien^Assigned Data Name^Data Key
+4 ; returns ".1" if EASKEY is invalid, i.e., data element is unknown
+5 ;
+6 NEW N,KEYIEN,X,XX,Y,DA,DIE,DR
+7 SET KEYIEN=""
+8 ;key passed in is Data Key
+9 IF EASKEY["."
IF EASKEY[";"
Begin DoDot:1
+10 SET KEYIEN=$ORDER(^EAS(711,"C",EASKEY,0))
if 'KEYIEN
QUIT
+11 SET X=$PIECE(^EAS(711,KEYIEN,0),U,1)
+12 SET KEYIEN=KEYIEN_U_X_U_EASKEY
End DoDot:1
+13 ;key passed in is Assigned Data Name
+14 IF KEYIEN=""
Begin DoDot:1
+15 IF $LENGTH(EASKEY)>50
Begin DoDot:2
+16 ;Fix problem when data passed in EASKEY is > 50 chars. (EAS*1*107)
+17 SET EASKEY=$EXTRACT(EASKEY,1,50)
+18 IF $EXTRACT(EASKEY,50)=" "
SET EASKEY=$EXTRACT(EASKEY,1,49)
End DoDot:2
+19 SET KEYIEN=$ORDER(^EAS(711,"AB",EASKEY,0))
if 'KEYIEN
QUIT
+20 SET X=$PIECE(^EAS(711,KEYIEN,0),U,2)
+21 SET KEYIEN=KEYIEN_U_EASKEY_U_X
End DoDot:1
+22 IF KEYIEN=""
SET KEYIEN=".1"
+23 QUIT KEYIEN
+24 ;
DATA712(EASAPP,EASKEY,EASMM) ;get 1010EZ data associated with data key
+1 ;input EASAPP = ien to #712 for Application
+2 ; EASKEY = IEN to file #711;
+3 ; OR KEYIEN returned by KEY711^EASEZU1
+4 ; EASMM = multiple number; default is 1; optional
+5 ; pertains to data elements that may be multiple,
+6 ; i.e., additional child dependents
+7 ;
+8 ;output RTR = piece 1 - 1010EZ data associated with Data Key for this Application;
+9 ; piece 2 - subrecord ien associated with Data Key for this Application;
+10 ; returns ^ if data item not found in this Application
+11 ;
+12 NEW N,OUT,KEYIEN,MULTIPLE,X,RTR,IN,UP
+13 IF '$DATA(^EAS(712,EASAPP,0))
QUIT U
+14 ;this is the "unknown" data element
+15 IF EASKEY=.1
QUIT U
+16 IF '$GET(EASMM)
SET EASMM=1
+17 SET KEYIEN=+EASKEY
+18 SET OUT=0
SET N=0
SET X=""
SET RTR=U
+19 FOR
SET N=$ORDER(^EAS(712,EASAPP,10,"B",KEYIEN,N))
if 'N
QUIT
Begin DoDot:1
+20 SET MULTIPLE=$PIECE($GET(^EAS(712,EASAPP,10,N,0)),U,2)
+21 IF MULTIPLE=EASMM
Begin DoDot:2
+22 ;use 'updated' data if present
+23 SET X=$GET(^EAS(712,EASAPP,10,N,1))
SET IN=$PIECE(X,U,1)
SET UP=$PIECE(X,U,2)
+24 SET RTR=$SELECT(UP'="":UP,1:IN)
SET RTR=RTR_U_N
SET OUT=1
End DoDot:2
End DoDot:1
if OUT
QUIT
+25 QUIT RTR
+26 ;
LINKUP(EASAPP,EASAEL,EASLINK) ;place link into a file #712 Data Element subrecord
+1 ;input EASAPP = ien to #712 for Application
+2 ; EASAEL = ien to Data Elements subrecord in #712
+3 ; EASLINK = file ien OR file_ien;subfile_ien to link 1010EZ data
+4 ; with existing Patient database record
+5 ;exit if record/subrecord not valid in #712
+6 NEW DA,DR,DIE,X,Y
+7 if 'EASAPP
QUIT
if '$DATA(^EAS(712,EASAPP,0))
QUIT
+8 if 'EASAEL
QUIT
if '$DATA(^EAS(712,EASAPP,10,EASAEL,0))
QUIT
+9 ;place link in Data Element subrecord of #712
+10 SET DA(1)=EASAPP
SET DA=EASAEL
SET DR(1)=10
+11 SET DIE="^EAS(712,EASAPP,10,"
+12 SET DR="2.1///^S X=EASLINK;"
+13 DO ^DIE
+14 QUIT
+15 ;
ADD71201(EASAPP,KEYIEN,LINK,MULTIPLE) ;add another subrecord to #712.01
+1 ;used in cases where Patient data exists but 1010EZ data does not;
+2 ;this new subrecord will hold the VistA database ien(s)
+3 ;
+4 ;input EASAPP = ien to file #712
+5 ; KEYIEN = ien to file #711 for data element
+6 ; LINK = ien(s) in VistA database;
+7 ; format: ien_main_file;ien_subfile
+8 ; MULTIPLE = default is 1; (optional)
+9 ; currently only needed for additional child dependents
+10 ; associated with Section IIB of the form.
+11 ;output NEWIEN = ien to new subrecord in sibfile #712.01
+12 NEW NEWIEN,LASTIEN,DA,DIC,DIE,DR,DLAYGO,DINUM,X,Y
+13 if 'KEYIEN
QUIT
+14 if LINK=""
QUIT
+15 SET LASTIEN=$ORDER(^EAS(712,EASAPP,10,9999),-1)
SET NEWIEN=LASTIEN+1
+16 ;create subrecord
+17 SET DIC="^EAS(712,EASAPP,10,"
SET DIC(0)="L"
SET DLAYGO=""
SET X=KEYIEN
SET DINUM=NEWIEN
+18 SET DA(1)=EASAPP
SET DIC("P")=$PIECE(^DD(712,10,0),U,2)
+19 KILL DD,DO
DO FILE^DICN
+20 ;file data element link
+21 SET DIE="^EAS(712,EASAPP,10,"
SET DA=NEWIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+22 SET MULTIPLE=$GET(MULTIPLE)
if 'MULTIPLE
SET MULTIPLE=1
+23 SET DR=".1///^S X=MULTIPLE;2.1///^S X=LINK;"
+24 DO ^DIE
+25 QUIT
+26 ;
GETANY(EASAPP,EASDFN,EASAEL,EASKEY) ;get data from VistA database for any field related to 1010EZ
+1 ;input EASAPP = ien to #712 for Application
+2 ; EASDFN = ien to #2 for Applicant
+3 ; either EASAEL or EASKEY must be non-null
+4 ; EASAEL = ien to Data Elements subrecord in #712; optional
+5 ; EASKEY = data key from Data Elements subrecord in #712; optional
+6 ;
+7 ;output RTR = data obtained from Patient database; external format
+8 ; OR -1 if invalid input
+9 ;
+10 ;the "link" below is a pointer (ien) to file or subfile record that
+11 ; was previously found to contain data which potentially matches
+12 ; 1010EZ data
+13 ;
+14 NEW X,LINK,N,FILE,SUBFILE,FIELD,ARRAY,DIQ,DA,DR,DIC,RTR
+15 SET EASKEY=$GET(EASKEY)
SET N=0
+16 IF 'EASAEL
IF EASKEY=""
QUIT -1
+17 IF 'EASAEL
IF EASKEY'=""
Begin DoDot:1
+18 SET EASAEL=$PIECE($$DATA712(EASAPP,EASKEY),U,2)
if 'EASAEL
QUIT
+19 SET N=$ORDER(^EAS(711,"C",EASKEY,0))
End DoDot:1
+20 IF EASKEY=""
IF EASAEL
SET N=$PIECE($GET(^EAS(712,EASAPP,10,EASAEL,0)),U,1)
+21 IF 'N
QUIT -1
+22 ;database parameters in #711
+23 SET X=$GET(^EAS(711,N,1))
SET FILE=$PIECE(X,U,1)
SET SUBFILE=$PIECE(X,U,2)
SET FIELD=$PIECE(X,U,3)
+24 ;get link ien if other than file #2
+25 SET LINK=$PIECE($GET(^EAS(712,EASAPP,10,EASAEL,2)),U,2)
+26 ;if data location is main file #2, then link is dfn
+27 IF FILE=2
IF (SUBFILE=2!SUBFILE="")
SET LINK=EASDFN
+28 ;
+29 ;if no link to database, quit
+30 IF 'LINK
QUIT -1
+31 ;otherwise setup FM call & use link to get data
+32 IF (SUBFILE="")!(SUBFILE=FILE)
Begin DoDot:1
+33 ;data in main file
+34 SET DIQ="ARRAY"
SET DIQ(0)="E"
SET DA=LINK
SET DR=FIELD
SET DIC=FILE
+35 DO EN^DIQ1
+36 SET RTR=$GET(ARRAY(FILE,LINK,FIELD,"E"))
End DoDot:1
+37 IF SUBFILE'=""
IF SUBFILE'=FILE
Begin DoDot:1
+38 ;data in subfile
+39 ;in this case LINK = file_ien;subfile_ien
+40 SET DIQ="ARRAY"
SET DIQ(0)="E"
SET DA=$PIECE(LINK,";",1)
SET DIC=FILE
+41 ;get field # for subfile
+42 SET DR=$ORDER(^DD(FILE,"SB",SUBFILE,0))
+43 SET DR(SUBFILE)=FIELD
SET DA(SUBFILE)=$PIECE(LINK,";",2)
+44 DO EN^DIQ1
+45 SET RTR=$GET(ARRAY(SUBFILE,$PIECE(LINK,";",2),FIELD,"E"))
End DoDot:1
+46 QUIT RTR
