- PSOEPUT2 ;BIR/TJL - ePCS Broker Utilities ;11/1/23 12:05
- ;;7.0;OUTPATIENT PHARMACY;**545,743,732**;DEC 1997;Build 10
- ;
- EPCSHELP(RESULTS,EPCSARY) ;
- ;
- ;Broker call returns the entries from HELP FILE #9.2
- ; RPC: PSO EPCS GET HELP
- ;INPUTS EPCSARY - Contains the following elements
- ; HELPDA - Help Frame Name
- ;
- ;OUTPUTS RESULTS - Array of help text in the HELP FRAME File (#9.2)
- ;
- N HELPDA,DIC,X,Y
- S HELPDA=$G(EPCSARY) I HELPDA="" Q
- D SETENV K ^TMP("EPCSHELP",$J)
- S DIC="^DIC(9.2,",DIC(0)="MN",X=HELPDA
- D ^DIC M ^TMP("EPCSHELP",$J)=^DIC(9.2,+Y,1)
- I $D(^TMP("EPCSHELP",$J)) D
- . S $P(^TMP("EPCSHELP",$J,0),U)=$P(^DIC(9.2,+Y,0),U,2)
- S RESULTS=$NA(^TMP("EPCSHELP",$J))
- Q
- ;
- EPCSDATE(RESULTS,EPCSARY) ;
- ;
- ;Broker call returns an FileMan internal date
- ; RPC: PSO EPCS SYSTEM DATE TIME
- ;INPUTS EPCSARY - Contains the following elements
- ; DTSTR - Date String (e.g., 'N' for 'Now')
- ;
- ;OUTPUTS RESULTS - A valid FileMan date format^External format
- ;
- N EPCSDATE,DIC,X,Y,DATESTR
- D SETENV
- S DATESTR=$P(EPCSARY,U) I DATESTR="" Q
- S X=DATESTR,%DT="XT",%DT(0)="-NOW" D ^%DT
- I +Y<1 S RESULTS="0^Invalid Date/Time" Q
- S RESULTS=Y D D^DIQ
- S RESULTS=RESULTS_U_Y
- Q
- ;
- SRCLST(RESULTS,EPCSARY) ;
- ;
- ; This broker entry returns an array of codes from a file
- ; based on a search string.
- ; RPC: PSO EPCS GET LIST
- ;
- ;INPUTS EPCSARY - Contains the following subscripted elements
- ; EPCSFILE - File to search
- ; EPCSSTR - Search string
- ; EPCSDIR - Search order
- ; EPCSNUM - (Optional) # records to return [default=44]
- ;OUTPUTS RESULTS - Array of values based on the search criteria.
- ;
- N EPCSFILE,EPCSSTR,EPCSDIR,EPCSORD,EPCSNUM
- D SETENV
- S EPCSFILE=$P(EPCSARY,U),EPCSSTR=$P(EPCSARY,U,2),EPCSDIR=$P(EPCSARY,U,3)
- S EPCSORD=$S(EPCSDIR=-1:"B",1:"I")
- K ^TMP($J,"EPCSFIND"),^TMP("EPCSSRCH",$J)
- I EPCSFILE="" Q
- S EPCSNUM=$S(+$P(EPCSARY,U,4)>0:$P(EPCSARY,U,4),1:44)
- I EPCSFILE=200 D PROV(EPCSNUM) ;Providers
- D SORT
- EXIT K ^TMP("EPCSSRCH",$J)
- S RESULTS=$NA(^TMP($J,"EPCSFIND"))
- Q
- ;
- SORT ;Order the data to be returned by the broker
- N COUNT
- S COUNT=0
- F S COUNT=$O(^TMP("EPCSSRCH",$J,"DILIST","ID",COUNT)) Q:'COUNT D
- .S ^TMP($J,"EPCSFIND",COUNT)=$G(^TMP("EPCSSRCH",$J,"DILIST","ID",COUNT,.01))_U_^TMP("EPCSSRCH",$J,"DILIST",2,COUNT)
- Q
- ;
- PROV(EPCSNUM) ;Return a set of providers from the NEW PERSON file
- ;Input Variables:-
- ; EPCSNUM - # of records to return
- ; FROM - text to begin $O from
- ; DATE - checks for an active person class on this date (optional)
- ; EPCSDIR - $O direction
- ; REPORT - Set to "R" to get all entries from file 200 OR set to blank
- ; if only users with a person class should be returned.
- ;
- ;Output Variables:-
- ; ^TMP($J,"EPCSFIND",1..n - returned array
- ; IEN of file 200^Provider Name^occupation^specialty^subspecialty
- ;
- N I,IEN,COUNT,FROM,DATE,EPCSUTN,REPORT S I=0,COUNT=$S(+$G(EPCSNUM)>0:EPCSNUM,1:44)
- S FROM=$P(EPCSSTR,"|"),DATE=$P(EPCSSTR,"|",2),REPORT=$P(EPCSSTR,"|",3)
- F Q:I'<COUNT S FROM=$O(^VA(200,"B",FROM),EPCSDIR) Q:FROM="" D
- . S IEN="" F S IEN=$O(^VA(200,"B",FROM,IEN),EPCSDIR) Q:'IEN D
- . . I IEN<1 Q ; Don't include special users postmaster and sharedmail
- . . I REPORT="R" S I=I+1,^TMP($J,"EPCSFIND",I)=IEN_"^"_FROM_"^" Q
- . . S EPCSUTN=$$GET^XUA4A72(IEN,DATE)
- . . S I=I+1,^TMP($J,"EPCSFIND",I)=IEN_"^"_FROM_"^"_$P(EPCSUTN,"^",2,4)
- Q
- SETENV ;
- I '$G(DUZ) D
- . S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
- . D NOW^%DTC S DT=X
- Q
- DELMULT(RETURN,NPIEN,DEATXT) ; Remove DEA multiple (#53.21) from the NEW PERSON file (#200)
- ; INPUT: NPIEN - NEW PERSON FILE #200 INTERNAL ENTRY NUMBER
- ; DEATXT - PROPERLY FORMATTED DEA NUMBER
- ; OUTPUT: RETURN - 1 for SUCCESS, 0 for UNSUCCESSFUL
- N FDA,IENS,MSGROOT,NPDEAIEN,DNDEAIEN,DEATYPE,DA,DIE,DR
- S RETURN=0 Q:'$G(NPIEN) Q:$G(DEATXT)=""
- S NPDEAIEN=$O(^VA(200,NPIEN,"PS4","B",DEATXT,0)) I 'NPDEAIEN Q
- S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
- S DEATYPE=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"I")
- S FDA(1,200.5321,NPDEAIEN_","_NPIEN_",",.01)="@"
- D UPDATE^DIE(,"FDA(1)",,"MSGROOT") Q:$D(MSGROOT)
- S RETURN=1
- Q
- ;
- ASK(TYPE,NAME,DELEG) ;Ask user if Allocate/De-allocate or Delegate/Un-delegate - returns y/n
- ;TYPE - flag weather Allocate/De-allocate or Delegate/Un-delegate
- ;Name - user's name
- N DIR,Y
- S DELEG=$G(DELEG,"")
- I DELEG S DIR("A")=$S(TYPE=1:"Un-delegate",1:"Delegate")_" PSDRPH for "_NAME
- I 'DELEG S DIR("A")=$S(TYPE=1:"De-allocate",1:"Allocate")_" PSDRPH for "_NAME
- S DIR("B")="Y"
- S DIR(0)="Y" D ^DIR K DIR
- Q Y
- ;
- PSDKEY(RESULTS,PSOSUBJ,PSOACTOR,PSOACTION) ;Allocate/De-allocate the PSDRPH key
- ; RESULTS - Success or Failure of the allocation/deallocation of the PSDRPH key.
- ; PSOSUBJ - The user to whom the PSDRPH key is being allocated/deallocated
- ; PSOACTOR - The user performing the allocation/deallocation of the PSDRPH key.
- ; PSOACTION - Action to perform - 1=Allocate, 0=Deallocate
- ;
- N PSOKEY,PSOMSG,PSOKSTAT,PSOIGNORE,PSOINPUT
- S PSOIGNORE=0 K RESULTS
- S PSOKSTAT=$$FIND1^DIC(200.051,","_PSOSUBJ_",",,"PSDRPH",,,"ERROR")
- S PSOACTION=$G(PSOACTION),PSOSUBJ=$G(PSOSUBJ),PSOACTOR=$G(PSOACTOR)
- I (PSOACTION'=1)&(PSOACTION'=0) S RESULTS="0^Invalid Action Code: "_PSOACTION Q
- S PSOKEY=$$LKUP^XPDKEY("PSDRPH")
- I PSOKEY="" S RESULTS="0^PSDRPH key does not exist" Q
- I 'PSOSUBJ S RESULTS="0^Missing or invalid key recipient input parameter." Q
- I 'PSOACTOR S RESULTS="0^Missing or invalid key allocator input parameter." Q
- I '$$FIND1^DIC(200,,,"`"_PSOSUBJ) S RESULTS="0^Key recipient IEN "_PSOSUBJ_" does not exist in the NEW PERSON file." Q
- I '$$FIND1^DIC(200,,,"`"_PSOACTOR) S RESULTS="0^Allocator IEN "_PSOACTOR_" does not exist in the NEW PERSON file." Q
- ;
- ;De-allocate key
- I PSOACTION=0 D
- . I 'PSOKSTAT S PSOIGNORE=1 Q ; Key not on file, take no action to avoid unnecessary audit file records
- . K DIK S DIK="^VA(200,PSOSUBJ,51,",DA(1)=PSOSUBJ,DA=PSOKEY D ^DIK
- ;
- ;Allocate key
- I PSOACTION=1 D
- . I PSOKSTAT S PSOIGNORE=1 Q ; Key already on file, take no action to avoid unnecessary audit file records
- . S FDA(200.051,"+1,"_PSOSUBJ_",",.01)="PSDRPH" D UPDATE^DIE("E","FDA","IEN","PSOMSG") D I $L($G(RESULTS)) Q
- . I '$$FIND1^DIC(200.051,","_PSOSUBJ_",",,"PSDRPH") S RESULTS="0^PSDRPH NOT FILED-"_$G(PSOMSG("DIERR",1,"TEXT",1))
- ;
- ;Set and record audit data
- I 'PSOIGNORE D
- . S NOW=$P($$HTE^XLFDT($H),":",1,2)
- . S PSOINPUT="`"_PSOSUBJ_"^"_"`"_PSOACTOR_"^"_PSOACTION D RECORD(PSOINPUT,NOW)
- ;
- ; Return true if intended state of PSDRPH exists, either by current action or pre-existing state
- S RESULTS=1
- Q
- ;
- RECORD(LINE,NOW) ;Record the edited data into audit file #8991.7
- N FDA,VALUE,IEN,MSG,I
- F I=1:1:3 S VALUE=$P(LINE,U,I),FDA(8991.7,"+1,",(I/100))=VALUE
- S FDA(8991.7,"+1,",.04)=NOW
- D UPDATE^DIE("E","FDA","IEN","MSG")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOEPUT2 6999 printed Feb 18, 2025@23:54:03 Page 2
- PSOEPUT2 ;BIR/TJL - ePCS Broker Utilities ;11/1/23 12:05
- +1 ;;7.0;OUTPATIENT PHARMACY;**545,743,732**;DEC 1997;Build 10
- +2 ;
- EPCSHELP(RESULTS,EPCSARY) ;
- +1 ;
- +2 ;Broker call returns the entries from HELP FILE #9.2
- +3 ; RPC: PSO EPCS GET HELP
- +4 ;INPUTS EPCSARY - Contains the following elements
- +5 ; HELPDA - Help Frame Name
- +6 ;
- +7 ;OUTPUTS RESULTS - Array of help text in the HELP FRAME File (#9.2)
- +8 ;
- +9 NEW HELPDA,DIC,X,Y
- +10 SET HELPDA=$GET(EPCSARY)
- IF HELPDA=""
- QUIT
- +11 DO SETENV
- KILL ^TMP("EPCSHELP",$JOB)
- +12 SET DIC="^DIC(9.2,"
- SET DIC(0)="MN"
- SET X=HELPDA
- +13 DO ^DIC
- MERGE ^TMP("EPCSHELP",$JOB)=^DIC(9.2,+Y,1)
- +14 IF $DATA(^TMP("EPCSHELP",$JOB))
- Begin DoDot:1
- +15 SET $PIECE(^TMP("EPCSHELP",$JOB,0),U)=$PIECE(^DIC(9.2,+Y,0),U,2)
- End DoDot:1
- +16 SET RESULTS=$NAME(^TMP("EPCSHELP",$JOB))
- +17 QUIT
- +18 ;
- EPCSDATE(RESULTS,EPCSARY) ;
- +1 ;
- +2 ;Broker call returns an FileMan internal date
- +3 ; RPC: PSO EPCS SYSTEM DATE TIME
- +4 ;INPUTS EPCSARY - Contains the following elements
- +5 ; DTSTR - Date String (e.g., 'N' for 'Now')
- +6 ;
- +7 ;OUTPUTS RESULTS - A valid FileMan date format^External format
- +8 ;
- +9 NEW EPCSDATE,DIC,X,Y,DATESTR
- +10 DO SETENV
- +11 SET DATESTR=$PIECE(EPCSARY,U)
- IF DATESTR=""
- QUIT
- +12 SET X=DATESTR
- SET %DT="XT"
- SET %DT(0)="-NOW"
- DO ^%DT
- +13 IF +Y<1
- SET RESULTS="0^Invalid Date/Time"
- QUIT
- +14 SET RESULTS=Y
- DO D^DIQ
- +15 SET RESULTS=RESULTS_U_Y
- +16 QUIT
- +17 ;
- SRCLST(RESULTS,EPCSARY) ;
- +1 ;
- +2 ; This broker entry returns an array of codes from a file
- +3 ; based on a search string.
- +4 ; RPC: PSO EPCS GET LIST
- +5 ;
- +6 ;INPUTS EPCSARY - Contains the following subscripted elements
- +7 ; EPCSFILE - File to search
- +8 ; EPCSSTR - Search string
- +9 ; EPCSDIR - Search order
- +10 ; EPCSNUM - (Optional) # records to return [default=44]
- +11 ;OUTPUTS RESULTS - Array of values based on the search criteria.
- +12 ;
- +13 NEW EPCSFILE,EPCSSTR,EPCSDIR,EPCSORD,EPCSNUM
- +14 DO SETENV
- +15 SET EPCSFILE=$PIECE(EPCSARY,U)
- SET EPCSSTR=$PIECE(EPCSARY,U,2)
- SET EPCSDIR=$PIECE(EPCSARY,U,3)
- +16 SET EPCSORD=$SELECT(EPCSDIR=-1:"B",1:"I")
- +17 KILL ^TMP($JOB,"EPCSFIND"),^TMP("EPCSSRCH",$JOB)
- +18 IF EPCSFILE=""
- QUIT
- +19 SET EPCSNUM=$SELECT(+$PIECE(EPCSARY,U,4)>0:$PIECE(EPCSARY,U,4),1:44)
- +20 ;Providers
- IF EPCSFILE=200
- DO PROV(EPCSNUM)
- +21 DO SORT
- EXIT KILL ^TMP("EPCSSRCH",$JOB)
- +1 SET RESULTS=$NAME(^TMP($JOB,"EPCSFIND"))
- +2 QUIT
- +3 ;
- SORT ;Order the data to be returned by the broker
- +1 NEW COUNT
- +2 SET COUNT=0
- +3 FOR
- SET COUNT=$ORDER(^TMP("EPCSSRCH",$JOB,"DILIST","ID",COUNT))
- if 'COUNT
- QUIT
- Begin DoDot:1
- +4 SET ^TMP($JOB,"EPCSFIND",COUNT)=$GET(^TMP("EPCSSRCH",$JOB,"DILIST","ID",COUNT,.01))_U_^TMP("EPCSSRCH",$JOB,"DILIST",2,COUNT)
- End DoDot:1
- +5 QUIT
- +6 ;
- PROV(EPCSNUM) ;Return a set of providers from the NEW PERSON file
- +1 ;Input Variables:-
- +2 ; EPCSNUM - # of records to return
- +3 ; FROM - text to begin $O from
- +4 ; DATE - checks for an active person class on this date (optional)
- +5 ; EPCSDIR - $O direction
- +6 ; REPORT - Set to "R" to get all entries from file 200 OR set to blank
- +7 ; if only users with a person class should be returned.
- +8 ;
- +9 ;Output Variables:-
- +10 ; ^TMP($J,"EPCSFIND",1..n - returned array
- +11 ; IEN of file 200^Provider Name^occupation^specialty^subspecialty
- +12 ;
- +13 NEW I,IEN,COUNT,FROM,DATE,EPCSUTN,REPORT
- SET I=0
- SET COUNT=$SELECT(+$GET(EPCSNUM)>0:EPCSNUM,1:44)
- +14 SET FROM=$PIECE(EPCSSTR,"|")
- SET DATE=$PIECE(EPCSSTR,"|",2)
- SET REPORT=$PIECE(EPCSSTR,"|",3)
- +15 FOR
- if I'<COUNT
- QUIT
- SET FROM=$ORDER(^VA(200,"B",FROM),EPCSDIR)
- if FROM=""
- QUIT
- Begin DoDot:1
- +16 SET IEN=""
- FOR
- SET IEN=$ORDER(^VA(200,"B",FROM,IEN),EPCSDIR)
- if 'IEN
- QUIT
- Begin DoDot:2
- +17 ; Don't include special users postmaster and sharedmail
- IF IEN<1
- QUIT
- +18 IF REPORT="R"
- SET I=I+1
- SET ^TMP($JOB,"EPCSFIND",I)=IEN_"^"_FROM_"^"
- QUIT
- +19 SET EPCSUTN=$$GET^XUA4A72(IEN,DATE)
- +20 SET I=I+1
- SET ^TMP($JOB,"EPCSFIND",I)=IEN_"^"_FROM_"^"_$PIECE(EPCSUTN,"^",2,4)
- End DoDot:2
- End DoDot:1
- +21 QUIT
- SETENV ;
- +1 IF '$GET(DUZ)
- Begin DoDot:1
- +2 SET DUZ=.5
- SET DUZ(0)="@"
- SET U="^"
- SET DTIME=300
- +3 DO NOW^%DTC
- SET DT=X
- End DoDot:1
- +4 QUIT
- DELMULT(RETURN,NPIEN,DEATXT) ; Remove DEA multiple (#53.21) from the NEW PERSON file (#200)
- +1 ; INPUT: NPIEN - NEW PERSON FILE #200 INTERNAL ENTRY NUMBER
- +2 ; DEATXT - PROPERLY FORMATTED DEA NUMBER
- +3 ; OUTPUT: RETURN - 1 for SUCCESS, 0 for UNSUCCESSFUL
- +4 NEW FDA,IENS,MSGROOT,NPDEAIEN,DNDEAIEN,DEATYPE,DA,DIE,DR
- +5 SET RETURN=0
- if '$GET(NPIEN)
- QUIT
- if $GET(DEATXT)=""
- QUIT
- +6 SET NPDEAIEN=$ORDER(^VA(200,NPIEN,"PS4","B",DEATXT,0))
- IF 'NPDEAIEN
- QUIT
- +7 SET DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
- +8 SET DEATYPE=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"I")
- +9 SET FDA(1,200.5321,NPDEAIEN_","_NPIEN_",",.01)="@"
- +10 DO UPDATE^DIE(,"FDA(1)",,"MSGROOT")
- if $DATA(MSGROOT)
- QUIT
- +11 SET RETURN=1
- +12 QUIT
- +13 ;
- ASK(TYPE,NAME,DELEG) ;Ask user if Allocate/De-allocate or Delegate/Un-delegate - returns y/n
- +1 ;TYPE - flag weather Allocate/De-allocate or Delegate/Un-delegate
- +2 ;Name - user's name
- +3 NEW DIR,Y
- +4 SET DELEG=$GET(DELEG,"")
- +5 IF DELEG
- SET DIR("A")=$SELECT(TYPE=1:"Un-delegate",1:"Delegate")_" PSDRPH for "_NAME
- +6 IF 'DELEG
- SET DIR("A")=$SELECT(TYPE=1:"De-allocate",1:"Allocate")_" PSDRPH for "_NAME
- +7 SET DIR("B")="Y"
- +8 SET DIR(0)="Y"
- DO ^DIR
- KILL DIR
- +9 QUIT Y
- +10 ;
- PSDKEY(RESULTS,PSOSUBJ,PSOACTOR,PSOACTION) ;Allocate/De-allocate the PSDRPH key
- +1 ; RESULTS - Success or Failure of the allocation/deallocation of the PSDRPH key.
- +2 ; PSOSUBJ - The user to whom the PSDRPH key is being allocated/deallocated
- +3 ; PSOACTOR - The user performing the allocation/deallocation of the PSDRPH key.
- +4 ; PSOACTION - Action to perform - 1=Allocate, 0=Deallocate
- +5 ;
- +6 NEW PSOKEY,PSOMSG,PSOKSTAT,PSOIGNORE,PSOINPUT
- +7 SET PSOIGNORE=0
- KILL RESULTS
- +8 SET PSOKSTAT=$$FIND1^DIC(200.051,","_PSOSUBJ_",",,"PSDRPH",,,"ERROR")
- +9 SET PSOACTION=$GET(PSOACTION)
- SET PSOSUBJ=$GET(PSOSUBJ)
- SET PSOACTOR=$GET(PSOACTOR)
- +10 IF (PSOACTION'=1)&(PSOACTION'=0)
- SET RESULTS="0^Invalid Action Code: "_PSOACTION
- QUIT
- +11 SET PSOKEY=$$LKUP^XPDKEY("PSDRPH")
- +12 IF PSOKEY=""
- SET RESULTS="0^PSDRPH key does not exist"
- QUIT
- +13 IF 'PSOSUBJ
- SET RESULTS="0^Missing or invalid key recipient input parameter."
- QUIT
- +14 IF 'PSOACTOR
- SET RESULTS="0^Missing or invalid key allocator input parameter."
- QUIT
- +15 IF '$$FIND1^DIC(200,,,"`"_PSOSUBJ)
- SET RESULTS="0^Key recipient IEN "_PSOSUBJ_" does not exist in the NEW PERSON file."
- QUIT
- +16 IF '$$FIND1^DIC(200,,,"`"_PSOACTOR)
- SET RESULTS="0^Allocator IEN "_PSOACTOR_" does not exist in the NEW PERSON file."
- QUIT
- +17 ;
- +18 ;De-allocate key
- +19 IF PSOACTION=0
- Begin DoDot:1
- +20 ; Key not on file, take no action to avoid unnecessary audit file records
- IF 'PSOKSTAT
- SET PSOIGNORE=1
- QUIT
- +21 KILL DIK
- SET DIK="^VA(200,PSOSUBJ,51,"
- SET DA(1)=PSOSUBJ
- SET DA=PSOKEY
- DO ^DIK
- End DoDot:1
- +22 ;
- +23 ;Allocate key
- +24 IF PSOACTION=1
- Begin DoDot:1
- +25 ; Key already on file, take no action to avoid unnecessary audit file records
- IF PSOKSTAT
- SET PSOIGNORE=1
- QUIT
- +26 SET FDA(200.051,"+1,"_PSOSUBJ_",",.01)="PSDRPH"
- DO UPDATE^DIE("E","FDA","IEN","PSOMSG")
- Begin DoDot:2
- End DoDot:2
- IF $LENGTH($GET(RESULTS))
- QUIT
- +27 IF '$$FIND1^DIC(200.051,","_PSOSUBJ_",",,"PSDRPH")
- SET RESULTS="0^PSDRPH NOT FILED-"_$GET(PSOMSG("DIERR",1,"TEXT",1))
- End DoDot:1
- +28 ;
- +29 ;Set and record audit data
- +30 IF 'PSOIGNORE
- Begin DoDot:1
- +31 SET NOW=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
- +32 SET PSOINPUT="`"_PSOSUBJ_"^"_"`"_PSOACTOR_"^"_PSOACTION
- DO RECORD(PSOINPUT,NOW)
- End DoDot:1
- +33 ;
- +34 ; Return true if intended state of PSDRPH exists, either by current action or pre-existing state
- +35 SET RESULTS=1
- +36 QUIT
- +37 ;
- RECORD(LINE,NOW) ;Record the edited data into audit file #8991.7
- +1 NEW FDA,VALUE,IEN,MSG,I
- +2 FOR I=1:1:3
- SET VALUE=$PIECE(LINE,U,I)
- SET FDA(8991.7,"+1,",(I/100))=VALUE
- +3 SET FDA(8991.7,"+1,",.04)=NOW
- +4 DO UPDATE^DIE("E","FDA","IEN","MSG")
- +5 QUIT