- 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 Feb 18, 2025@23:51:58 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
