- ORDV02D ;SLC/DCM - OE/RR REPORT EXTRACTS ;JAN 16, 2024@11:20
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**423,377,603**;Dec 17, 1997;Build 14
- ;
- OV ;Overview
- D EXT("OV")
- Q
- PEND ;Pending
- D EXT("PEND")
- Q
- ALL ;ALL
- D EXT("ALL")
- Q
- EXT(ORPRT) ;New Lab Reports Extract
- N S,DP,ORLIST,STARTDT,STAT,IFN,OS,CST,TEST,COLL,ODT,NM,RL,MD,GMI,SORT,D,SN,STATUS,X4,LRODT,LRSN,ORMERG,ORX0,ORIFN,X1,X2,X3,FLAG,IVEDT,IVSDT
- K ^TMP("OR",$J),^TMP("OROR",$J),^TMP("ORSORT",$J),^TMP("ORR",$J)
- S X=$O(^ORD(100.98,"B","LAB",0)) Q:'X S DP=X ; Display group = LAB
- S FLAG=1,X3=1,OS="",TEST="",GMI=0
- S X1=0,X2=9999999 ;Get everything to ensure all orders are included, then sort later by date ranges
- I ORPRT="OV" S SORT="On Collection List:2^COLLECTED:3^PROCESSING:4^COMPLETED:6"
- I ORPRT="PEND" S SORT="ORDERED:1^On Collection List:2^COLLECTED:3^PROCESSING:4"
- I ORPRT="ALL" S SORT="ORDERED:1^On Collection List:2^COLLECTED:3^PROCESSING:4^CANCELED:5^COMPLETED:6"
- D EN^ORQ1(DFN_";DPT(",DP,FLAG,"",X1,X2,X3)
- S IFN=0
- F S IFN=$O(^TMP("ORR",$J,ORLIST,IFN)) Q:IFN<1 S X=^(IFN) D
- . S ORIFN=+$P(X,"^"),STARTDT=$P(X,"^",4),STAT=$P(X,"^",6)
- . Q:'$D(^OR(100,ORIFN,0)) S ORX0=^(0),X4=$G(^(4))
- . I 'STARTDT S STARTDT=$S($L($P(X4,";",5)):9999999-$P(X4,";",5),1:$P(X,"^",3)) ;If no StartDate use lab CollectionDate or OrderDate
- . S LRODT=$P(X4,";",2),LRSN=$P(X4,";",3),ORMERG=0
- . I ORPRT="OV" D GET ;Set date for Inverse Start Date, sort by Date then Status, exclude ORDERED, CANCELED
- . I ORPRT="PEND" D GET ;Set date for Forward Start Date, sort by Date then Status, exclude COMPLETED, CANCELED
- . I ORPRT="ALL" D GET ;Set date for Inverse Start Date, sort by Status then Date
- S D=0
- S IVEDT=ORDBEG,IVSDT=ORDEND,D=IVEDT
- F S D=$O(^TMP("OROR",$J,D)) Q:'D!(D>IVSDT) D
- . S SN=0
- . F S SN=$O(^TMP("OROR",$J,D,SN)) Q:'SN S ORX0=^(SN) I $L(ORX0) S STATUS=$P(ORX0,"^",5) I $L($P(ORX0,"^")) D
- .. S S=$E(SORT,$F(SORT,STATUS)+1)
- .. I ORPRT="OV",STATUS'="ORDERED",STATUS'="CANCELED" S ^TMP("ORSORT",$J,9999999-D,S,SN)=ORX0 ;Reverse sort order DM-603
- .. I ORPRT="PEND",STATUS'="CANCELED",STATUS'="COMPLETED" S ^TMP("ORSORT",$J,9999999-D,S,SN)=ORX0
- .. I ORPRT="ALL" S ^TMP("ORSORT",$J,S,D,SN)=ORX0
- K ^TMP("OROR",$J),^TMP("ORR",$J)
- Q
- GET ;
- N ORI,ORX,GOTLR
- S ORI=0
- F S ORI=$O(^OR(100,ORIFN,4.5,"ID","ORDERABLE",ORI)) Q:ORI<1 I $D(^OR(100,ORIFN,4.5,ORI,1)) S ORX=^(1) D
- . S GOTLR=0
- . I $D(^ORD(101.43,+ORX,0)) S (TEST,ORX)=+$P(^(0),"^",2)
- . I ORX,LRODT,LRSN,$D(^LRO(69,LRODT,1,LRSN,2,"B",ORX)) S ORX=$O(^(ORX,0)) D
- .. Q:'$L($G(^LRO(69,LRODT,1,LRSN,0)))
- .. I $G(^LRO(69,LRODT,1,LRSN,2,ORX,0)) S ORX=^(0),GOTLR=1 D GET69
- . I 'ORMERG,'GOTLR D GET63 ;Get data from file 63 and OE/RR
- Q
- GET63 ; Get data from file 63 and OE/RR files
- N SUB,CDT,LRIDT,X0,SPEC,OS,MD,IFN,PKG,FILE,NM,MD,ACC,ODT,URG,COLL,CD,RDT,LRDFN,FNF,NSPACE
- Q:'$L($P(X4,";",4)) Q:'$L($P(X4,";",5))
- S SUB=$P(X4,";",4),LRIDT=$P(X4,";",5)
- I '$D(DFN) S DFN=$S($D(ORVP):+ORVP,1:0) Q:'DFN
- Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR") Q:'$D(^LR(LRDFN))
- Q:'$D(^LR(LRDFN,SUB,LRIDT,0)) S X0=^(0)
- S X=STARTDT D REGDTM4 S CDT=X
- S TEST=TEST_";"_$P($G(^LAB(60,+TEST,0)),"^"),SPEC=+$P(X0,"^",5)_";"_$P($G(^LAB(61,+$P(X0,"^",5),0)),"^"),OS=$S($P(X0,"^",3):"COMPLETED",1:"PROCESSING")
- S (MD,IFN)=$P(X0,"^",10),FNF=0,NSPACE="LR"
- I SUB="MI" S (MD,IFN)=$P(X0,"^",7)
- S PKG=$$VERSION^XPDUTL(NSPACE),FILE=$S($G(PKG)<5.2:6,1:200)
- S NM=$S($L($P($G(^VA(200,+MD,0)),"^")):$P(^(0),"^"),1:"UNKOWN"),MD=+MD_";"_NM,ACC=$P(X0,"^",6)
- S X=$P(ORX0,"^",7) D REGDTM4 S ODT=X
- S X=$P(X0,"^",3) D REGDTM4 S RDT=X
- S URG="UNKNOWN",COLL="UNKNOWN",CD=$P($P(ORX0,"^",7),".") ;COLL=Collection Type
- S GMI=GMI+1,^TMP("OROR",$J,STARTDT,GMI)=CDT_U_TEST_U_SPEC_U_URG_U_OS_U_MD_U_ODT_U_ACC_U_RDT_U_COLL_U_CD_U_ORIFN
- Q
- GET69 ; Get data from Lab Order/accession (69, 68) files
- N X,IDT,SPEC,SITE,BADTEST,FST,SPST
- I $L($P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7)) S ORMERG=1 Q ;exclude merged orders from extract
- I $D(^LRO(69,LRODT,1,LRSN,0)) S SPST=^(0) D ORDER
- I $D(^LRO(69,LRODT,1,LRSN,1)) S CST=^(1) D COLLECT I 1
- E S OS="ORDERED",X=$P(^LRO(69,LRODT,1,LRSN,0),U,8),IDT=9999999-X D REGDTM4 S CDT=X
- I $D(^LRO(69,LRODT,1,LRSN,3)) S FST=^(3) D RESULT I 1
- E S RDT=""
- S SITE=+$G(^LRO(69,LRODT,1,LRSN,4,+$O(^LRO(69,LRODT,1,LRSN,4,0)),0)),SPEC=$S(SITE>0:SITE_";"_$P(^LAB(61,SITE,0),U),1:";UNKNOWN")
- S:$P(ORX,"^",9)="CA" OS="CANCELED"
- D TEST69
- I $D(BADTEST) K BADTEST Q
- S GMI=GMI+1,^TMP("OROR",$J,STARTDT,GMI)=CDT_U_TEST_U_SPEC_U_URG_U_OS_U_MD_U_ODT_U_ACC_U_RDT_U_COLL_U_LRODT_U_$P(ORX,U,7)
- Q
- ORDER ; Get Orders
- N IFN,FNF,FILE,NM,NSPACE,PKG,X
- S COLL=$S($L($P(SPST,U,4)):$P(SPST,U,4),1:"UNKNOWN")
- S:"LW"[COLL COLL=$S(COLL="L":"LAB",1:"WARD")
- S X=$P(SPST,U,5) D REGDTM4 S ODT=X
- S (MD,IFN)=$P(SPST,U,6),FNF=0,NSPACE="LR"
- S PKG=$$VERSION^XPDUTL(NSPACE),FILE=$S($G(PKG)<5.2:6,1:200)
- S NM=$S($L($P($G(^VA(200,+MD,0)),"^")):$P(^(0),"^"),1:"UNKOWN"),MD=+MD_";"_NM
- S RL=$P(SPST,U,7)
- Q
- COLLECT ;Get Collection status from 69
- N X,CS
- S X=STARTDT D REGDTM4 S CDT=X
- S CS=$P(CST,U,4),OS="COLLECTED"
- S OS=$S(CS="C":"COLLECTED",X="U":"CANCELED",1:"On Collection List")
- Q
- RESULT ;Get Result status
- N X S X=$P(FST,U,2) D REGDTM4 S RDT=X
- I X S OS="COMPLETED"
- Q
- TEST69 ;Get Collection status from file 68 (overrides 69)
- N TPTR,UPTR,ACCD,ACCA,ACCN,X
- S TPTR=+ORX,UPTR=$P(ORX,U,2)
- I '$D(^LAB(60,+TPTR,0)) S BADTEST=1 Q
- S ACCD=$P(ORX,U,3),ACCA=$P(ORX,U,4),ACCN=$P(ORX,U,5)
- S TEST=TPTR_";"_$S($L($P(^LAB(60,TPTR,0),U))<21:$P(^(0),U),1:$P(^(.1),U))
- S URG=$E($S($D(^LAB(62.05,+UPTR,0)):$P(^(0),U),1:""),1,7)
- I $S('$D(ACCD):1,'$L(ACCA):1,'$L(ACCD):1,1:0) S ACC="NONE" Q
- S ACC=$S($D(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,.2)):^(.2),1:"NONE")
- I $D(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,4,TPTR,0)) S X=$P(^(0),U,5) D
- . I $G(OS)'="CANCELED",$G(OS)'="On Collection List" S OS=$S('$L(X):"PROCESSING",1:"COMPLETED")
- Q
- REGDTM4 ;Receives X FM date and returns X in MM/DD/YYYY TT:TT
- S X=$TR($$FMTE^XLFDT(X,"5ZM"),"@"," ")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV02D 6031 printed Feb 18, 2025@23:56:40 Page 2
- ORDV02D ;SLC/DCM - OE/RR REPORT EXTRACTS ;JAN 16, 2024@11:20
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**423,377,603**;Dec 17, 1997;Build 14
- +2 ;
- OV ;Overview
- +1 DO EXT("OV")
- +2 QUIT
- PEND ;Pending
- +1 DO EXT("PEND")
- +2 QUIT
- ALL ;ALL
- +1 DO EXT("ALL")
- +2 QUIT
- EXT(ORPRT) ;New Lab Reports Extract
- +1 NEW S,DP,ORLIST,STARTDT,STAT,IFN,OS,CST,TEST,COLL,ODT,NM,RL,MD,GMI,SORT,D,SN,STATUS,X4,LRODT,LRSN,ORMERG,ORX0,ORIFN,X1,X2,X3,FLAG,IVEDT,IVSDT
- +2 KILL ^TMP("OR",$JOB),^TMP("OROR",$JOB),^TMP("ORSORT",$JOB),^TMP("ORR",$JOB)
- +3 ; Display group = LAB
- SET X=$ORDER(^ORD(100.98,"B","LAB",0))
- if 'X
- QUIT
- SET DP=X
- +4 SET FLAG=1
- SET X3=1
- SET OS=""
- SET TEST=""
- SET GMI=0
- +5 ;Get everything to ensure all orders are included, then sort later by date ranges
- SET X1=0
- SET X2=9999999
- +6 IF ORPRT="OV"
- SET SORT="On Collection List:2^COLLECTED:3^PROCESSING:4^COMPLETED:6"
- +7 IF ORPRT="PEND"
- SET SORT="ORDERED:1^On Collection List:2^COLLECTED:3^PROCESSING:4"
- +8 IF ORPRT="ALL"
- SET SORT="ORDERED:1^On Collection List:2^COLLECTED:3^PROCESSING:4^CANCELED:5^COMPLETED:6"
- +9 DO EN^ORQ1(DFN_";DPT(",DP,FLAG,"",X1,X2,X3)
- +10 SET IFN=0
- +11 FOR
- SET IFN=$ORDER(^TMP("ORR",$JOB,ORLIST,IFN))
- if IFN<1
- QUIT
- SET X=^(IFN)
- Begin DoDot:1
- +12 SET ORIFN=+$PIECE(X,"^")
- SET STARTDT=$PIECE(X,"^",4)
- SET STAT=$PIECE(X,"^",6)
- +13 if '$DATA(^OR(100,ORIFN,0))
- QUIT
- SET ORX0=^(0)
- SET X4=$GET(^(4))
- +14 ;If no StartDate use lab CollectionDate or OrderDate
- IF 'STARTDT
- SET STARTDT=$SELECT($LENGTH($PIECE(X4,";",5)):9999999-$PIECE(X4,";",5),1:$PIECE(X,"^",3))
- +15 SET LRODT=$PIECE(X4,";",2)
- SET LRSN=$PIECE(X4,";",3)
- SET ORMERG=0
- +16 ;Set date for Inverse Start Date, sort by Date then Status, exclude ORDERED, CANCELED
- IF ORPRT="OV"
- DO GET
- +17 ;Set date for Forward Start Date, sort by Date then Status, exclude COMPLETED, CANCELED
- IF ORPRT="PEND"
- DO GET
- +18 ;Set date for Inverse Start Date, sort by Status then Date
- IF ORPRT="ALL"
- DO GET
- End DoDot:1
- +19 SET D=0
- +20 SET IVEDT=ORDBEG
- SET IVSDT=ORDEND
- SET D=IVEDT
- +21 FOR
- SET D=$ORDER(^TMP("OROR",$JOB,D))
- if 'D!(D>IVSDT)
- QUIT
- Begin DoDot:1
- +22 SET SN=0
- +23 FOR
- SET SN=$ORDER(^TMP("OROR",$JOB,D,SN))
- if 'SN
- QUIT
- SET ORX0=^(SN)
- IF $LENGTH(ORX0)
- SET STATUS=$PIECE(ORX0,"^",5)
- IF $LENGTH($PIECE(ORX0,"^"))
- Begin DoDot:2
- +24 SET S=$EXTRACT(SORT,$FIND(SORT,STATUS)+1)
- +25 ;Reverse sort order DM-603
- IF ORPRT="OV"
- IF STATUS'="ORDERED"
- IF STATUS'="CANCELED"
- SET ^TMP("ORSORT",$JOB,9999999-D,S,SN)=ORX0
- +26 IF ORPRT="PEND"
- IF STATUS'="CANCELED"
- IF STATUS'="COMPLETED"
- SET ^TMP("ORSORT",$JOB,9999999-D,S,SN)=ORX0
- +27 IF ORPRT="ALL"
- SET ^TMP("ORSORT",$JOB,S,D,SN)=ORX0
- End DoDot:2
- End DoDot:1
- +28 KILL ^TMP("OROR",$JOB),^TMP("ORR",$JOB)
- +29 QUIT
- GET ;
- +1 NEW ORI,ORX,GOTLR
- +2 SET ORI=0
- +3 FOR
- SET ORI=$ORDER(^OR(100,ORIFN,4.5,"ID","ORDERABLE",ORI))
- if ORI<1
- QUIT
- IF $DATA(^OR(100,ORIFN,4.5,ORI,1))
- SET ORX=^(1)
- Begin DoDot:1
- +4 SET GOTLR=0
- +5 IF $DATA(^ORD(101.43,+ORX,0))
- SET (TEST,ORX)=+$PIECE(^(0),"^",2)
- +6 IF ORX
- IF LRODT
- IF LRSN
- IF $DATA(^LRO(69,LRODT,1,LRSN,2,"B",ORX))
- SET ORX=$ORDER(^(ORX,0))
- Begin DoDot:2
- +7 if '$LENGTH($GET(^LRO(69,LRODT,1,LRSN,0)))
- QUIT
- +8 IF $GET(^LRO(69,LRODT,1,LRSN,2,ORX,0))
- SET ORX=^(0)
- SET GOTLR=1
- DO GET69
- End DoDot:2
- +9 ;Get data from file 63 and OE/RR
- IF 'ORMERG
- IF 'GOTLR
- DO GET63
- End DoDot:1
- +10 QUIT
- GET63 ; Get data from file 63 and OE/RR files
- +1 NEW SUB,CDT,LRIDT,X0,SPEC,OS,MD,IFN,PKG,FILE,NM,MD,ACC,ODT,URG,COLL,CD,RDT,LRDFN,FNF,NSPACE
- +2 if '$LENGTH($PIECE(X4,";",4))
- QUIT
- if '$LENGTH($PIECE(X4,";",5))
- QUIT
- +3 SET SUB=$PIECE(X4,";",4)
- SET LRIDT=$PIECE(X4,";",5)
- +4 IF '$DATA(DFN)
- SET DFN=$SELECT($DATA(ORVP):+ORVP,1:0)
- if 'DFN
- QUIT
- +5 if '$DATA(^DPT(DFN,"LR"))
- QUIT
- SET LRDFN=+^DPT(DFN,"LR")
- if '$DATA(^LR(LRDFN))
- QUIT
- +6 if '$DATA(^LR(LRDFN,SUB,LRIDT,0))
- QUIT
- SET X0=^(0)
- +7 SET X=STARTDT
- DO REGDTM4
- SET CDT=X
- +8 SET TEST=TEST_";"_$PIECE($GET(^LAB(60,+TEST,0)),"^")
- SET SPEC=+$PIECE(X0,"^",5)_";"_$PIECE($GET(^LAB(61,+$PIECE(X0,"^",5),0)),"^")
- SET OS=$SELECT($PIECE(X0,"^",3):"COMPLETED",1:"PROCESSING")
- +9 SET (MD,IFN)=$PIECE(X0,"^",10)
- SET FNF=0
- SET NSPACE="LR"
- +10 IF SUB="MI"
- SET (MD,IFN)=$PIECE(X0,"^",7)
- +11 SET PKG=$$VERSION^XPDUTL(NSPACE)
- SET FILE=$SELECT($GET(PKG)<5.2:6,1:200)
- +12 SET NM=$SELECT($LENGTH($PIECE($GET(^VA(200,+MD,0)),"^")):$PIECE(^(0),"^"),1:"UNKOWN")
- SET MD=+MD_";"_NM
- SET ACC=$PIECE(X0,"^",6)
- +13 SET X=$PIECE(ORX0,"^",7)
- DO REGDTM4
- SET ODT=X
- +14 SET X=$PIECE(X0,"^",3)
- DO REGDTM4
- SET RDT=X
- +15 ;COLL=Collection Type
- SET URG="UNKNOWN"
- SET COLL="UNKNOWN"
- SET CD=$PIECE($PIECE(ORX0,"^",7),".")
- +16 SET GMI=GMI+1
- SET ^TMP("OROR",$JOB,STARTDT,GMI)=CDT_U_TEST_U_SPEC_U_URG_U_OS_U_MD_U_ODT_U_ACC_U_RDT_U_COLL_U_CD_U_ORIFN
- +17 QUIT
- GET69 ; Get data from Lab Order/accession (69, 68) files
- +1 NEW X,IDT,SPEC,SITE,BADTEST,FST,SPST
- +2 ;exclude merged orders from extract
- IF $LENGTH($PIECE($GET(^LRO(69,LRODT,1,LRSN,1)),"^",7))
- SET ORMERG=1
- QUIT
- +3 IF $DATA(^LRO(69,LRODT,1,LRSN,0))
- SET SPST=^(0)
- DO ORDER
- +4 IF $DATA(^LRO(69,LRODT,1,LRSN,1))
- SET CST=^(1)
- DO COLLECT
- IF 1
- +5 IF '$TEST
- SET OS="ORDERED"
- SET X=$PIECE(^LRO(69,LRODT,1,LRSN,0),U,8)
- SET IDT=9999999-X
- DO REGDTM4
- SET CDT=X
- +6 IF $DATA(^LRO(69,LRODT,1,LRSN,3))
- SET FST=^(3)
- DO RESULT
- IF 1
- +7 IF '$TEST
- SET RDT=""
- +8 SET SITE=+$GET(^LRO(69,LRODT,1,LRSN,4,+$ORDER(^LRO(69,LRODT,1,LRSN,4,0)),0))
- SET SPEC=$SELECT(SITE>0:SITE_";"_$PIECE(^LAB(61,SITE,0),U),1:";UNKNOWN")
- +9 if $PIECE(ORX,"^",9)="CA"
- SET OS="CANCELED"
- +10 DO TEST69
- +11 IF $DATA(BADTEST)
- KILL BADTEST
- QUIT
- +12 SET GMI=GMI+1
- SET ^TMP("OROR",$JOB,STARTDT,GMI)=CDT_U_TEST_U_SPEC_U_URG_U_OS_U_MD_U_ODT_U_ACC_U_RDT_U_COLL_U_LRODT_U_$PIECE(ORX,U,7)
- +13 QUIT
- ORDER ; Get Orders
- +1 NEW IFN,FNF,FILE,NM,NSPACE,PKG,X
- +2 SET COLL=$SELECT($LENGTH($PIECE(SPST,U,4)):$PIECE(SPST,U,4),1:"UNKNOWN")
- +3 if "LW"[COLL
- SET COLL=$SELECT(COLL="L":"LAB",1:"WARD")
- +4 SET X=$PIECE(SPST,U,5)
- DO REGDTM4
- SET ODT=X
- +5 SET (MD,IFN)=$PIECE(SPST,U,6)
- SET FNF=0
- SET NSPACE="LR"
- +6 SET PKG=$$VERSION^XPDUTL(NSPACE)
- SET FILE=$SELECT($GET(PKG)<5.2:6,1:200)
- +7 SET NM=$SELECT($LENGTH($PIECE($GET(^VA(200,+MD,0)),"^")):$PIECE(^(0),"^"),1:"UNKOWN")
- SET MD=+MD_";"_NM
- +8 SET RL=$PIECE(SPST,U,7)
- +9 QUIT
- COLLECT ;Get Collection status from 69
- +1 NEW X,CS
- +2 SET X=STARTDT
- DO REGDTM4
- SET CDT=X
- +3 SET CS=$PIECE(CST,U,4)
- SET OS="COLLECTED"
- +4 SET OS=$SELECT(CS="C":"COLLECTED",X="U":"CANCELED",1:"On Collection List")
- +5 QUIT
- RESULT ;Get Result status
- +1 NEW X
- SET X=$PIECE(FST,U,2)
- DO REGDTM4
- SET RDT=X
- +2 IF X
- SET OS="COMPLETED"
- +3 QUIT
- TEST69 ;Get Collection status from file 68 (overrides 69)
- +1 NEW TPTR,UPTR,ACCD,ACCA,ACCN,X
- +2 SET TPTR=+ORX
- SET UPTR=$PIECE(ORX,U,2)
- +3 IF '$DATA(^LAB(60,+TPTR,0))
- SET BADTEST=1
- QUIT
- +4 SET ACCD=$PIECE(ORX,U,3)
- SET ACCA=$PIECE(ORX,U,4)
- SET ACCN=$PIECE(ORX,U,5)
- +5 SET TEST=TPTR_";"_$SELECT($LENGTH($PIECE(^LAB(60,TPTR,0),U))<21:$PIECE(^(0),U),1:$PIECE(^(.1),U))
- +6 SET URG=$EXTRACT($SELECT($DATA(^LAB(62.05,+UPTR,0)):$PIECE(^(0),U),1:""),1,7)
- +7 IF $SELECT('$DATA(ACCD):1,'$LENGTH(ACCA):1,'$LENGTH(ACCD):1,1:0)
- SET ACC="NONE"
- QUIT
- +8 SET ACC=$SELECT($DATA(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,.2)):^(.2),1:"NONE")
- +9 IF $DATA(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,4,TPTR,0))
- SET X=$PIECE(^(0),U,5)
- Begin DoDot:1
- +10 IF $GET(OS)'="CANCELED"
- IF $GET(OS)'="On Collection List"
- SET OS=$SELECT('$LENGTH(X):"PROCESSING",1:"COMPLETED")
- End DoDot:1
- +11 QUIT
- REGDTM4 ;Receives X FM date and returns X in MM/DD/YYYY TT:TT
- +1 SET X=$TRANSLATE($$FMTE^XLFDT(X,"5ZM"),"@"," ")
- +2 QUIT
