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