Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORNORC

ORNORC.m

Go to the documentation of this file.
  1. ORNORC ; SLC/AJB - New Order Checks for Cancelled Orders ;Mar 03, 2023@13:15:07
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,588**;Dec 17, 1997;Build 29
  1. ;
  1. ; Reference to ^DD( in ICR #999
  1. ;
  1. Q
  1. ;
  1. CANCEL(CHECKS,DFN,PACKAGE,LOC,DATA,STRT) ; capture a cancelled order
  1. N ORDATA,ORDITM,ORIEN,ORIENS,ORITEMS,ORMSG
  1. S (ORIEN(1),ORITEMS)=""
  1. ;Check for no previous Cancel entry and create a new entry if needed
  1. S ORIEN(1)=$O(^XTMP("ORCHECK-"_DUZ,$J,DFN,$$DT^XLFDT,ORIEN(1)),-1)
  1. I $G(ORIEN(1))="" D
  1. . K ORIEN(1)
  1. . S ORDATA(100.3,"+1,",.01)=$$NOW^XLFDT
  1. . S ORDATA(100.3,"+1,",.02)=DFN
  1. . S ORDATA(100.3,"+1,",.03)=DUZ
  1. . S ORDATA(100.3,"+1,",.04)=+LOC
  1. . S ORDATA(100.3,"+1,",.05)="C"
  1. . S ORDATA(100.3,"+1,",.06)=PACKAGE
  1. . S ORDATA(100.3,"+1,",.08)=STRT
  1. . D UPDATE^DIE("","ORDATA","ORIEN","ORMSG") I +$D(ORMSG) Q
  1. ; get orderable item(s)
  1. S ORDITM=0
  1. F S ORDITM=$O(^OR(100.3,+ORIEN(1),1,ORDITM)) Q:+ORDITM=0 D
  1. . S ORITEMS=$S(ORITEMS="":+$G(^OR(100.3,+ORIEN(1),1,ORDITM,0)),1:U_+$G(^OR(100.3,+ORIEN(1),1,ORDITM,0)))
  1. N NUM S NUM=0 F S NUM=$O(DATA(NUM)) Q:'+NUM D
  1. . I NUM=1 D
  1. . . I ORITEMS[+DATA(NUM) Q
  1. . . S ORDATA(100.31,"+1,"_ORIEN(1)_",",.01)=+DATA(NUM)
  1. . . S ORITEMS=$S(ORITEMS="":+DATA(NUM),1:ORITEMS_U_+DATA(NUM))
  1. . I $P(DATA(NUM),U,2)="ORDERABLE",ORITEMS'[$P(DATA(NUM),U,4) D
  1. . . S ORDATA(100.31,"+1,"_ORIEN(1)_",",.01)=$P(DATA(NUM),U,4)
  1. . . S ORITEMS=$S(ORITEMS="":$P(DATA(NUM),U,4),1:ORITEMS_U_$P(DATA(NUM),U,4))
  1. . I +$D(ORDATA) D UPDATE^DIE("","ORDATA",,"ORMSG") I +$D(ORMSG) Q
  1. ; get order checks
  1. S NUM=0 F S NUM=$O(CHECKS(NUM)) Q:'+NUM D
  1. . N DATA,IEN,ORXTRA
  1. . S ORDATA(100.32,"+1,"_ORIEN(1)_",",.01)=$P(CHECKS(NUM),U,2)
  1. . S ORDATA(100.32,"+1,"_ORIEN(1)_",",.02)=$P(CHECKS(NUM),U,3)
  1. . S ORDATA(100.32,"+1,"_ORIEN(1)_",",1)=$P(CHECKS(NUM),U,4)
  1. . I ORDATA(100.32,"+1,"_ORIEN(1)_",",1)["||" D ; check for extra data
  1. . . S ORXTRA=$P($P(ORDATA(100.32,"+1,"_ORIEN(1)_",",1),"||",2),"&")
  1. . . S ORDATA(100.32,"+1,"_ORIEN(1)_",",1)=$P(ORDATA(100.32,"+1,"_ORIEN(1)_",",1),"&",2)
  1. . . D GETXTRA^ORCHECK(.DATA,ORXTRA,ORDATA(100.32,"+1,"_ORIEN(1)_",",1))
  1. . D UPDATE^DIE("","ORDATA","IEN","ORMSG") I +$D(ORMSG) Q
  1. . D WP^DIE(100.32,IEN(1)_","_ORIEN(1)_",",2,,"DATA","ORMSG") I +$D(ORMSG) Q
  1. ; set raw order data
  1. D WP^DIE(100.3,ORIEN(1)_",",3,,"DATA","ORMSG")
  1. ; set xtmp to find entries to be removed (#100.03) if order is initially accepted
  1. I '+ORIEN(1) Q
  1. S ^XTMP("ORCHECK-"_DUZ,0)=$$FMADD^XLFDT($$DT^XLFDT,1)_U_$$DT^XLFDT
  1. S ^XTMP("ORCHECK-"_DUZ,$J,DFN,$$DT^XLFDT,ORIEN(1))=ORITEMS
  1. Q
  1. DELORC(ORVP,ORDIALOG) ; delete order checks from 100.3/avoid duplication in 100 & 100.05
  1. N LOC S LOC=$NA(ORDIALOG),ORVP=+ORVP
  1. I '+$D(^XTMP("ORCHECK-"_DUZ)) Q
  1. N JOB,ORCHECK,ORITEMS,ORDT,NUM
  1. S JOB=$J,ORDT=$$DT^XLFDT
  1. S ORCHECK="",ORCHECK=$O(^XTMP("ORCHECK-"_DUZ,JOB,ORVP,ORDT,ORCHECK),-1) ; get most recent IEN from 100.3 for the given user,job,patient,date
  1. I '+ORCHECK Q
  1. S NUM=0,ORITEMS="" F S NUM=$O(@LOC@(4,NUM)) Q:'+NUM D
  1. . S ORITEMS=$S(ORITEMS="":@LOC@(4,NUM),1:ORITEMS_U_@LOC@(4,NUM)) ; get all orderable items
  1. I ORITEMS=^XTMP("ORCHECK-"_DUZ,JOB,ORVP,ORDT,ORCHECK) D
  1. . N DA,DIK S DIK="^OR(100.3,",DA=ORCHECK D ^DIK ; remove entry from 100.3
  1. . K ^XTMP("ORCHECK-"_DUZ,JOB,ORVP) ; remove xtmp data
  1. Q
  1. ORCAN(ORIEN,OCC) ; order has been cancelled/changed after acceptance
  1. N ORCHK
  1. D GETOC2^OROCAPI1(+ORIEN,.ORCHK) I '+$D(ORCHK) Q ; quit if no order checks for the order
  1. N ORDATA,ORMSG
  1. S ORDATA(100.3,"+1,",.01)=$$NOW^XLFDT
  1. S ORDATA(100.3,"+1,",.02)=$G(DFN)
  1. S ORDATA(100.3,"+1,",.03)=DUZ
  1. S ORDATA(100.3,"+1,",.05)=OCC
  1. S ORDATA(100.3,"+1,",.07)=+ORIEN
  1. D UPDATE^DIE("","ORDATA","ORIEN","ORMSG") I +$D(ORMSG) Q
  1. D ; get orderable items
  1. . N DATA,IEN D GETS^DIQ(100,ORIEN,".1*","I","DATA")
  1. . S IEN="" F S IEN=$O(DATA(100.001,IEN)) Q:'+IEN D
  1. . . N ORDATA S ORDATA(100.31,"+1,"_ORIEN(1)_",",.01)=DATA(100.001,IEN,.01,"I")
  1. . . D UPDATE^DIE("","ORDATA","","ORMSG")
  1. S ORCHK=0 F S ORCHK=$O(ORCHK(ORIEN,ORCHK)) Q:'+ORCHK D
  1. . N DATA,IEN,ORDATA D GETS^DIQ(100.05,ORCHK_",","5;6;8","I","DATA")
  1. . S ORDATA(100.32,"+1,"_ORIEN(1)_",",.01)=DATA(100.05,ORCHK_",",5,"I")
  1. . S ORDATA(100.32,"+1,"_ORIEN(1)_",",.02)=DATA(100.05,ORCHK_",",6,"I")
  1. . S ORDATA(100.32,"+1,"_ORIEN(1)_",",1)=DATA(100.05,ORCHK_",",8,1)
  1. . D UPDATE^DIE("","ORDATA","","ORMSG")
  1. Q
  1. EN ; main entry for creating a delimited report via HOST FILE or displaying CANCELLED ORDERS via ListManager
  1. W @IOF
  1. N CONT,LOC,POP,SRCH,X,Y
  1. S CONT=0,LOC=$NA(^TMP("ORCHK",$J)) K @LOC ; set global location of entries
  1. D SETUP(.SRCH) ; setup search parameters from user
  1. I '+CONT W !!,"Search parameter entry aborted.",! Q
  1. D FIND(.SRCH,LOC) ; find entries that match search criteria
  1. I +$D(SRCH("DLM")) D Q
  1. . N %ZIS,DSC,IOP,POP,RTN,ZTSAVE,ZTSK
  1. . S ZTSAVE("JOB")="",ZTSAVE("SRCH")="",ZTSAVE("LOC")=""
  1. . S %ZIS="Q" ;,%ZIS("HFSNAME")=SRCH("DLM"),IOP="Q;HFS"
  1. . S DSC="Cancelled Order Report",RTN="REPORT^ORNORC(LOC)"
  1. . W ! D EN^XUTMDEVQ(RTN,DSC,.ZTSAVE,.%ZIS,1)
  1. . I +$G(ZTSK) W !!,"Task #",ZTSK
  1. ; start ListManager
  1. D EN^OROCLM(.SRCH,LOC)
  1. K @LOC
  1. Q
  1. SETUP(SRCH) ; user required input for search parameters
  1. N DIR,POP,SRCHCRIT,X,Y
  1. S DIR(0)="S^LM:ListManager;DLM:Delmited Data Host File"
  1. S DIR("A")="LM/DLM",DIR("B")="LM"
  1. S DIR("L",1)="Select which type of data output: "
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" LM ListManager Display"
  1. S DIR("L")=" DLM Delimited Data via Host File"
  1. W ! D ^DIR I Y'["LM" Q
  1. I Y="DLM" S SRCH("DLM")=1 ; D
  1. ;. S SRCH("DLM")=$$DEFDIR^%ZISH()_$$UP^XLFSTR($TR($$FMTE^XLFDT(DT,8)," ","_"))_"_ORDER_CHECK_REPORT.CSV"
  1. ;. W !!,"Your report will be located:",!!,$P(SRCH("DLM"),U),$P(SRCH("DLM"),U,2)
  1. LM ;
  1. D I '+$D(SRCH("ADATE"))!'+$D(SRCH("BDATE")) Q ; get a date range from user
  1. . N %DT,DIR,X,Y S %DT(0)=-$$DT^XLFDT,%DT="AEX",%DT("A")="Select Beginning DATE: ",%DT("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-30))
  1. . W ! D ^%DT K %DT Q:Y<0 S SRCH("ADATE")=Y
  1. . S DIR("A")=" Ending DATE: ",DIR("B")="TODAY",DIR(0)="DA"_U_SRCH("ADATE")_":"_$$DT^XLFDT_":EX"
  1. . S DIR("?",1)="Enter a date between "_$$FMTE^XLFDT(SRCH("ADATE"))_" and "_$$FMTE^XLFDT($$DT^XLFDT)_".",DIR("?")=" "
  1. . W ! D ^DIR Q:Y'>0 S SRCH("BDATE")=Y
  1. ;
  1. S DIR(0)="YA",DIR("A")="Would you like to select additional SEARCH CRITERIA? ",DIR("B")="NO"
  1. W ! D ^DIR I '+Y S CONT=$S(+$G(DIRUT):0,+$G(DUOUT):0,1:1) Q
  1. ;
  1. S SRCHCRIT=$$SRCHCRIT(.SRCHCRIT,"A","OCCURRENCE","ORCHK SRCHPARAM 1 MAIN MENU","Enter search criteria: ") Q:SRCHCRIT=-1
  1. S CONT=1 F X=1:1:SRCHCRIT D
  1. . I SRCHCRIT(X)["LOCATION" D I SRCH("LOCATION")=-1 S X=SRCHCRIT,CONT=0 Q
  1. . . W ! S SRCH("LOCATION")=$$FLU(44)
  1. . I SRCHCRIT(X)["OCCURRENCE" D I '+$D(SRCH("OCCURRENCE")) S SRCH("OCCURRENCE")=-1,X=SRCHCRIT,CONT=0 Q
  1. . . N SRCHCRIT,X S SRCHCRIT=$$SRCHCRIT(.SRCHCRIT,"A","CANCELLED","ORCHK SRCHPARAM 2 OCCURRENCE MENU","Enter OCCURRENCE(S): ") Q:SRCHCRIT=-1
  1. . . S SRCH("OCCURRENCE")="" F X=1:1:SRCHCRIT D
  1. . . . S SRCH("OCCURRENCE")=SRCH("OCCURRENCE")_$S($P(SRCHCRIT(X),U,3)="CANCELLED":"C",$P(SRCHCRIT(X),U,3)="ACCEPTED/CANCELLED":"AC",1:"RT")_$S(SRCHCRIT=X:"",1:U)
  1. . I SRCHCRIT(X)["PATIENT" D I SRCH("PATIENT")=-1 S X=SRCHCRIT,CONT=0 Q
  1. . . W ! S SRCH("PATIENT")=$$FLU(2)
  1. . I SRCHCRIT(X)["USER" D I SRCH("USER")=-1 S X=SRCHCRIT,CONT=0 Q
  1. . . W ! S SRCH("USER")=$$FLU(200)
  1. . I SRCHCRIT(X)["ORDERABLE ITEM" D I SRCH("ORDITEM")=-1 S X=SRCHCRIT,CONT=0 Q
  1. . . W ! S SRCH("ORDITEM")=$$FLU(101.43)
  1. . I SRCHCRIT(X)["ORDER CHECK" D I SRCH("ORDCHECK")=-1 S X=SRCHCRIT,CONT=0 Q
  1. . . W ! S SRCH("ORDCHECK")=$$FLU(100.8)
  1. . I SRCHCRIT(X)["CLINICAL DANGER LEVEL" D I '+$D(SRCH("CDL")) S SRCH("CDL")=-1,X=SRCHCRIT,CONT=0 Q
  1. . . N SRCHCRIT,X S SRCHCRIT=$$SRCHCRIT(.SRCHCRIT,"A","HIGH","ORCHK SRCHPARAM 3 DANGER MENU","Enter CLINICAL DANGER LEVEL: ") I SRCHCRIT=-1 S CONT=0 Q
  1. . . S SRCH("CDL")="" F X=1:1:SRCHCRIT D
  1. . . . S SRCH("CDL")=SRCH("CDL")_$S($P(SRCHCRIT(X),U,3)="HIGH":"1",$P(SRCHCRIT(X),U,3)="MEDIUM":"2",1:"3")_$S(SRCHCRIT=X:"",1:U)
  1. Q
  1. FIND(SRCH,LOC) ;
  1. N BDT,GBL,IEN S IEN=0,GBL=$NA(^OR(100.3))
  1. F BDT=SRCH("ADATE"):1:SRCH("BDATE") S IEN=0 F S IEN=$O(@GBL@("B",BDT,IEN)) Q:'+IEN D
  1. . N DATA,MATCH S MATCH=""
  1. . ; CANCELLED orders are only located in File #100.3
  1. . I $G(SRCH("OCCURRENCE"))'="C",+$D(@GBL@("ORDER",IEN)) D
  1. . . N OIEN S OIEN="",OIEN=$O(@GBL@("ORDER",IEN,OIEN)) Q:'+OIEN D
  1. . . . N DATA1,ORCHK
  1. . . . D GETS^DIQ(100,OIEN_",",".02;3;6;.1*","IN","DATA1")
  1. . . . S DATA("PATIENT")=+DATA1(100,OIEN_",",.02,"I"),DATA("USER")=DATA1(100,OIEN_",",3,"I"),DATA("LOCATION")=+DATA1(100,OIEN_",",6,"I")
  1. . . . S (DATA1,DATA("ORDITEM"))="" F S DATA1=$O(DATA1(100.001,DATA1)) Q:'+DATA1 D
  1. . . . . S DATA("ORDITEM")=DATA("ORDITEM")_DATA1(100.001,DATA1,.01,"I")_$S(+$O(DATA1(100.001,DATA1)):U,1:"")
  1. . . . D GETOC2^OROCAPI1(OIEN,.ORCHK)
  1. . . . S (DATA("ORDCHECK"),DATA("CDL"),ORCHK)="" F S ORCHK=$O(ORCHK(OIEN,ORCHK)) Q:'+ORCHK D
  1. . . . . D GETS^DIQ(100.05,ORCHK_",","5;6","IN","DATA1")
  1. . . . . S DATA("ORDCHECK")=DATA("ORDCHECK")_DATA1(100.05,ORCHK_",",5,"I")_$S(+$O(ORCHK(OIEN,ORCHK)):U,1:"")
  1. . . . . S DATA("CDL")=DATA("CDL")_DATA1(100.05,ORCHK_",",6,"I")_$S(+$O(ORCHK(OIEN,ORCHK)):U,1:"")
  1. . S SRCH="BDATE" F S SRCH=$O(SRCH(SRCH)) Q:SRCH="" D
  1. . . I SRCH="DLM" Q ; not a search parameter
  1. . . S MATCH=MATCH_$$MATCH(SRCH,SRCH(SRCH),$G(DATA(SRCH)))_U
  1. . I +$L(MATCH,U)=1 S MATCH=1 ; if no failed search parameters, it's a match
  1. . I MATCH[0 Q
  1. . S @LOC@(IEN)=""
  1. Q
  1. MATCH(INDEX,SRCHCRIT,DATA) ;
  1. I SRCHCRIT=DATA Q 1
  1. I +$D(@GBL@(INDEX,SRCH(INDEX),IEN)) Q 1
  1. N X,Y S Y=0
  1. I INDEX="CDL" F X=1:1:$L(SRCHCRIT,U) D
  1. . I +$D(@GBL@(INDEX,$P(SRCHCRIT,U,X),IEN)) S Y=1 Q
  1. . I DATA[$P(SRCHCRIT,U,X) S Y=1
  1. I INDEX="OCCURRENCE" F X=1:1:$L(SRCHCRIT,U) I +$D(@GBL@(INDEX,$P(SRCHCRIT,U,X),IEN)) S Y=1 Q
  1. I INDEX="ORDCHECK"!(INDEX="ORDITEM") F X=1:1:$L(DATA) D
  1. . I $P(DATA,U,X)=SRCHCRIT S Y=1 Q
  1. Q Y
  1. FLU(FILE) ; file lookup
  1. N DIC,FINFO,X,Y
  1. D FILE^DID(FILE,,"NAME;GLOBAL NAME","FINFO")
  1. S DIC=FINFO("GLOBAL NAME"),DIC(0)="AEMQ",DIC("A")="Select "_FINFO("NAME")_": "
  1. D ^DIC
  1. Q +Y
  1. SRCHCRIT(Y,PARAM,DEFAULT,MENU,PROMPT) ; get search criteria using menu & actions from the protocol file
  1. N I,X,XQORM
  1. S XQORM=+$O(^ORD(101,"B",MENU,0))_";ORD(101,"
  1. I '+XQORM Q "-1^Menu entry not found."
  1. S XQORM(0)=$G(PARAM),XQORM("A")=PROMPT,XQORM("B")=DEFAULT
  1. D EN^XQORM
  1. Q $G(Y)
  1. REPORT(LOC) ; writes the data for the host file(s)
  1. N FCNT,FLDORD,IEN,IOM,SEQ S IOM=9999,SEQ=0 ; set sequence for fields
  1. N DELIM S DELIM="," ; set delimiter for report
  1. ;
  1. ; Call FILEDD(<file#>) and S FCNT(SEQ,X)=FCNT for each FILE to be in the host file
  1. ; FCNT is the total field count for each file for displaying FILE info above headers
  1. ;
  1. N X F X=100.3,100,100.05 S FCNT=0 D FILEDD(X) S FCNT(SEQ,X)=FCNT
  1. ;
  1. D HDR K FLDORD
  1. S IEN=0 F S IEN=$O(@LOC@(IEN)) Q:'+IEN D
  1. . N ORDER,ORCHK
  1. . D GODATA(100.3,IEN,1) ; main entry from File #100.3
  1. . S ORDER=+$$GET1^DIQ(100.3,IEN,.07) I +ORDER D Q
  1. . . D GODATA(100,ORDER) ; main entry from File #100 (ORDER) - one ORDER per CANCELLED ORDER (#100.3)
  1. . . D GETOC2^OROCAPI1(ORDER,.ORCHK) ; get order checks for the ORDER
  1. . . N CNT S CNT=0,ORCHK="" F S ORCHK=$O(ORCHK(ORDER,ORCHK)) Q:'+ORCHK D
  1. . . . ; the main entry from File #100.05 (ORDER CHECK INSTANCES) - one or more per ORDER
  1. . . . S CNT=CNT+1 I CNT=1 D GODATA(100.05,ORCHK) W $C(182) Q
  1. . . . ; multi line results for an ORDER need "blank" entries for each file that precedes it
  1. . . . D GODATA(100.3,,1),GODATA(100),GODATA(100.05,ORCHK) W $C(182)
  1. . W $C(182)
  1. K @LOC
  1. Q
  1. GODATA(FILE,IEN,STRT) ; get and output the file data
  1. N DATA,FLDORD
  1. N FN,FLD
  1. I +$G(FILE),+$G(IEN) S IEN=IEN_"," D GETS^DIQ(FILE,IEN,"**","N","DATA")
  1. W:+$G(STRT) ! W:'+$G(STRT) ","
  1. D FILEDD(FILE)
  1. S (SEQ,FN,FLD)=0 F S SEQ=$O(FLDORD(SEQ)) Q:'+SEQ F S FN=$O(FLDORD(SEQ,FN)) Q:'+FN F S FLD=$O(FLDORD(SEQ,FN,FLD)) Q:'+FLD D
  1. . N CNT,SIEN S (CNT,SIEN)=""
  1. . F S SIEN=$O(DATA(FN,SIEN)) Q:'+SIEN D
  1. . . I +$D(DATA(FN,SIEN,FLD)) D
  1. . . . S CNT=CNT+1
  1. . . . W:CNT=1 $C(34)
  1. . . . I $$GET1^DID(FN,FLD,,"TYPE")="WORD-PROCESSING" D
  1. . . . . N NUM S NUM=0 F S NUM=$O(DATA(FN,SIEN,FLD,NUM)) Q:'+NUM D
  1. . . . . . W $$QM(DATA(FN,SIEN,FLD,NUM)) W:+$O(DATA(FN,SIEN,FLD,NUM)) !
  1. . . . W:$$GET1^DID(FN,FLD,,"TYPE")'="WORD-PROCESSING" $$QM(DATA(FN,SIEN,FLD))
  1. . . . W:+$O(DATA(FN,SIEN)) !
  1. . I +CNT D Q
  1. . . W $C(34)
  1. . . I +$O(FLDORD($S($$GET1^DID(FN,FLD,,"TYPE")="WORD-PROCESSING":(SEQ+1),1:SEQ))) W DELIM Q
  1. . I '+CNT D
  1. . . I +FLDORD(SEQ,FN,FLD),$$GET1^DID(FN,FLD,,"TYPE")="WORD-PROCESSING" D
  1. . . . W $$QM("")
  1. . . . I +$O(FLDORD((SEQ+1))) W DELIM Q
  1. . . I '+FLDORD(SEQ,FN,FLD),$$GET1^DID(FN,FLD,,"TYPE")'="WORD-PROCESSING" D
  1. . . . W $$QM("")
  1. . . . I +$O(FLDORD(SEQ)) W DELIM Q
  1. Q
  1. FILEDD(FILENUM) ; establishes file/field sequence via the data dictionary ; IA #999
  1. ; FCNT,SEQ must be set prior to calling
  1. N NODE,PIECE,FLD S (NODE,PIECE,FLD)=""
  1. I +$D(^DD(FILENUM,"GL")) F S NODE=$O(^DD(FILENUM,"GL",NODE)) Q:NODE="" F S PIECE=$O(^DD(FILENUM,"GL",NODE,PIECE)) Q:PIECE="" F S FLD=$O(^DD(FILENUM,"GL",NODE,PIECE,FLD)) Q:'+FLD D
  1. . N NODE0 S NODE0=$G(^DD(FILENUM,FLD,0))
  1. . I +$P(NODE0,U,2) D Q
  1. . . S SEQ=SEQ+1,FLDORD(SEQ,FILENUM,FLD)=+$P(NODE0,U,2)
  1. . . D FILEDD(+$P(NODE0,U,2))
  1. . S FCNT=FCNT+1,SEQ=SEQ+1,FLDORD(SEQ,FILENUM,FLD)=""
  1. Q
  1. HDR ; write field names for the column headers
  1. N CNT,FILE,X
  1. S CNT=1,(FCNT,FILE)="" F S FCNT=$O(FCNT(FCNT)) Q:'+FCNT F S FILE=$O(FCNT(FCNT,FILE)) Q:'+FILE D
  1. . N NAME D FILE^DID(FILE,,"NAME","NAME")
  1. . S CNT=CNT+FCNT(FCNT,FILE)
  1. . S $P(X,DELIM,(CNT-FCNT(FCNT,FILE)))="File #"_FILE_" ["_NAME("NAME")_"]"
  1. W X,!
  1. ;
  1. N SEQ,FN,FLD
  1. S (SEQ,FN,FLD)=0 F S SEQ=$O(FLDORD(SEQ)) Q:'+SEQ F S FN=$O(FLDORD(SEQ,FN)) Q:'+FN F S FLD=$O(FLDORD(SEQ,FN,FLD)) Q:'+FLD D
  1. . I '+FLDORD(SEQ,FN,FLD) D Q ; not a multiple
  1. . . W $$QM($$GET1^DID(FN,FLD,,"LABEL"),1) I +$O(FLDORD(SEQ)) W DELIM ; field data & delim
  1. Q
  1. QM(DATA,QM) ; for excel importing as csv, replace a single double quote with two double quotes
  1. I DATA[$C(34) N X S X("""")="""""" S DATA=$$REPLACE^XLFSTR(DATA,.X)
  1. Q $S(+$G(QM):$C(34)_DATA_$C(34),1:DATA)