- 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 Jan 18, 2025@02:56:27 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