VAQFILE2.m

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 ---VAQFILE2   1690     printed  Apr 09, 2024@21:29: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