VAQFILE2 ;ALB/MFK - MESSAGE FILING;19-OCT-95
;;1.5;PATIENT DATA EXCHANGE;**16,20**;NOV 17, 1993
FILESEG(FILE,DA,FIELD,VALUE1,VALUE2,VALUE3) ;FILE INFORMATION
;INPUT : FILE - File number
; DA - IFN of entry to edit
; FIELD - Field of multiple
; VALUE1 - Name of segment to be filed
; VALUE2 - Time limit of segment being filed
; VALUE3 - Occurrence limit of segment being filed
;OUTPUT : 0 - Success
; -1^Error_text - Error
;NOTES : It is the responsibility of
; the calling routine to verify that VALUE can be added as
; an entry in the multiple. It is also the responsibility
; of the calling routine to verify that VALUE is an entry in
; the subfile when deleting/editing.
;
;CHECK INPUT
Q:('$G(FILE)) "-1^Did not pass file number"
Q:('$D(^DD(FILE))) "-1^Did not pass valid file number"
Q:('$G(DA)) "-1^Did not pass entry number"
Q:('$D(FIELD)) "-1^Field not passed"
S VALUE1=$G(VALUE1)
Q:(VALUE1="") "-1^No .01 sent"
S VALUE2=$G(VALUE2)
S VALUE3=$G(VALUE3)
;DECLARE VARIABLES
N DIE,DR,X,DIC,Y,DLAYGO
K DD,DO
; SET UP FILE^DICN CALL
S DIC=$G(^DIC(FILE,0,"GL"))
S DIC(0)="XL"
S DLAYGO=FILE
Q:(DIC="") "-1^Could not determine global root of file"
Q:('$D(@(DIC_DA_")"))) "-1^Did not pass valid entry number"
S MULT=$P($P($G(^DD(FILE,FIELD,0)),"^",4),";",1)
S DIC=DIC_DA_",MULT,"
S DIC("P")=+$P($G(^DD(FILE,FIELD,0)),"^",2)
I ('DIC("P")) Q "-1^Main field is not a multiple"
S DA(1)=DA
S DIC("DR")=".01////"_VALUE1_";.02////"_VALUE2_";.03////"_VALUE3
S X=VALUE1
D FILE^DICN
Q:($D(Y)="-1") "-1^Could not file new value"
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFILE2 1690 printed Oct 16, 2024@18:26:39 Page 2
VAQFILE2 ;ALB/MFK - MESSAGE FILING;19-OCT-95
+1 ;;1.5;PATIENT DATA EXCHANGE;**16,20**;NOV 17, 1993
FILESEG(FILE,DA,FIELD,VALUE1,VALUE2,VALUE3) ;FILE INFORMATION
+1 ;INPUT : FILE - File number
+2 ; DA - IFN of entry to edit
+3 ; FIELD - Field of multiple
+4 ; VALUE1 - Name of segment to be filed
+5 ; VALUE2 - Time limit of segment being filed
+6 ; VALUE3 - Occurrence limit of segment being filed
+7 ;OUTPUT : 0 - Success
+8 ; -1^Error_text - Error
+9 ;NOTES : It is the responsibility of
+10 ; the calling routine to verify that VALUE can be added as
+11 ; an entry in the multiple. It is also the responsibility
+12 ; of the calling routine to verify that VALUE is an entry in
+13 ; the subfile when deleting/editing.
+14 ;
+15 ;CHECK INPUT
+16 if ('$GET(FILE))
QUIT "-1^Did not pass file number"
+17 if ('$DATA(^DD(FILE)))
QUIT "-1^Did not pass valid file number"
+18 if ('$GET(DA))
QUIT "-1^Did not pass entry number"
+19 if ('$DATA(FIELD))
QUIT "-1^Field not passed"
+20 SET VALUE1=$GET(VALUE1)
+21 if (VALUE1="")
QUIT "-1^No .01 sent"
+22 SET VALUE2=$GET(VALUE2)
+23 SET VALUE3=$GET(VALUE3)
+24 ;DECLARE VARIABLES
+25 NEW DIE,DR,X,DIC,Y,DLAYGO
+26 KILL DD,DO
+27 ; SET UP FILE^DICN CALL
+28 SET DIC=$GET(^DIC(FILE,0,"GL"))
+29 SET DIC(0)="XL"
+30 SET DLAYGO=FILE
+31 if (DIC="")
QUIT "-1^Could not determine global root of file"
+32 if ('$DATA(@(DIC_DA_")")))
QUIT "-1^Did not pass valid entry number"
+33 SET MULT=$PIECE($PIECE($GET(^DD(FILE,FIELD,0)),"^",4),";",1)
+34 SET DIC=DIC_DA_",MULT,"
+35 SET DIC("P")=+$PIECE($GET(^DD(FILE,FIELD,0)),"^",2)
+36 IF ('DIC("P"))
QUIT "-1^Main field is not a multiple"
+37 SET DA(1)=DA
+38 SET DIC("DR")=".01////"_VALUE1_";.02////"_VALUE2_";.03////"_VALUE3
+39 SET X=VALUE1
+40 DO FILE^DICN
+41 if ($DATA(Y)="-1")
QUIT "-1^Could not file new value"
+42 QUIT 0
