OROCLM ; SLC/AJB - ListManager Display for Cancelled Orders ;May 17, 2018@12:28
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
Q
VIEW ;
N DATA,IEN,ORDER,X
D FULL^VALM1 W @IOF
S IEN=$O(@VALMAR@("IDX",SEL,""))
S ORDER=$$GET1^DIQ(100.3,IEN,.07)
S DATA("DATE")=$$FIXDT($$FMTE^XLFDT($E($$GET1^DIQ(100.3,IEN,.01,"I"),1,12),2))
S DATA("PATIENT")=$S('+ORDER:$$GET1^DIQ(100.3,IEN,.02),+ORDER:$$GET1^DIQ(100,ORDER,.02))
S DATA("ENTERED")=$S('+ORDER:$$GET1^DIQ(100.3,IEN,.03),+ORDER:$$GET1^DIQ(100,ORDER,3))
S DATA("USER")=$$GET1^DIQ(100.3,IEN,.03)
S DATA("OCCURRENCE")=$$GET1^DIQ(100.3,IEN,.05)
S X=0
S X=X+1,DATA(X)="Cancelled Order Information",DATA(X)=$$SETSTR^VALM1(DATA(X),"",IOM-$L(DATA(X))/2,$L(DATA(X))) ;,$P(DATA(X),U,2)="IORVON",$P(DATA(X),U,3)="IORVOFF"
;
S X=X+1,DATA(X)="Date/Time",DATA(X)=$$SETSTR^VALM1("Patient Name",DATA(X),IOM-12/2,12),DATA(X)=$$SETSTR^VALM1("Occurrence",DATA(X),IOM-9,10)
;
S X=X+1,DATA(X)=DATA("DATE"),DATA(X)=$$SETSTR^VALM1(DATA("PATIENT"),DATA(X),IOM-$L(DATA("PATIENT"))/2,$L(DATA("PATIENT")))
S DATA(X)=$$SETSTR^VALM1(DATA("OCCURRENCE"),DATA(X),IOM-($L(DATA("OCCURRENCE"))-1),$L(DATA("OCCURRENCE"))),$P(DATA(X),U,2)="IOUON",$P(DATA(X),U,3)="IOUOFF"
;
S X=X+1,DATA(X)=""
S X=X+1,DATA(X)="Orderable Item(s)",$P(DATA(X),U,2)="IORVON",$P(DATA(X),U,3)="IORVOFF"
;
D
. N CNT,FILE,FLDS,OCC,OUT,ORCHK
. S OCC=$$GET1^DIQ(100.3,IEN_",",.05,"I")
. S FILE=$S(OCC="CH":100.3,+ORDER:100,1:100.3)
. S FLDS=$S(FILE=100:".1*",1:"1*;2*")
. D GETS^DIQ(FILE,$S(OCC="CH":IEN,+ORDER:ORDER,1:IEN)_",",FLDS,"NE","OUT")
. I +$D(OUT) S OUT=0,FILE=$O(OUT(FILE)) F S OUT=$O(OUT(FILE,OUT)) Q:'+OUT S X=X+1,DATA(X)=OUT(FILE,OUT,.01,"E") ; orderable items
. ;
. S FILE=$S(OCC="CH":100.32,+ORDER:100.05,1:100.32) I +ORDER D
. . N ORCHK D GETOC2^OROCAPI1(ORDER,.ORCHK)
. . S ORCHK=0 F S ORCHK=$O(ORCHK(ORDER,ORCHK)) Q:'+ORCHK D GETS^DIQ(FILE,ORCHK_",","5;6;8","E","OUT")
. S (CNT,OUT)=0
. F S OUT=$O(OUT(FILE,OUT)) Q:'+OUT D
. . S CNT=CNT+1
. . I CNT=1 S X=X+1,DATA(X)="",X=X+1,DATA(X)="Order Check Information",DATA(X)=$$SETSTR^VALM1(DATA(X),"",IOM-$L(DATA(X))/2,$L(DATA(X))) ;,$P(DATA(X),U,2)="IORVON",$P(DATA(X),U,3)="IORVOFF"
. . I CNT=1 S X=X+1,DATA(X)="Type"
. . I CNT=1 S X=X+1,DATA(X)="Message",DATA(X)=$$SETSTR^VALM1("Clinical Danger Level",DATA(X),40,41),$P(DATA(X),U,2)="IOUON",$P(DATA(X),U,3)="IOUOFF"
. . ;
. . S X=X+1,DATA(X)=OUT(FILE,OUT,$S(OCC="CH":.01,+ORDER:5,1:.01),"E"),DATA(X)=$$SETSTR^VALM1(OUT(FILE,OUT,$S(OCC="CH":.02,+ORDER:6,1:.02),"E"),DATA(X),40,41)
. . I '+ORDER!(OCC="CH") S X=X+1,DATA(X)=OUT(FILE,OUT,1,"E") ; S X=X+1,DATA(X)=""
. . ;
. . N I S I=0 F S I=$O(OUT(FILE,OUT,$S(OCC="CH":2,+ORDER:8,1:2),I)) Q:'+I S X=X+1,DATA(X)=OUT(FILE,OUT,$S(OCC="CH":2,+ORDER:8,1:2),I)
. . S X=X+1,DATA(X)=""
;
S X=0 F S X=$O(DATA(X)) Q:'+X D
. W:X>1 ! I $Y>(IOSL-3) I $$READ("EA",IORVON_"Press <ENTER> to continue..."_IORVOFF) W @IOF
. W:$P(DATA(X),U,2)'="" @$P(DATA(X),U,2) W $P(DATA(X),U) W:$P(DATA(X),U,3)'="" @$P(DATA(X),U,3)
F Q:$Y>(IOSL-3) W !
I $$READ("EA",IORVON_"Press <ENTER> to continue..."_IORVOFF)
Q
EN(SRCH,LOC) ;
D EN^VALM("OR ORDER CHECKS DISPLAY")
Q
HDR ;
S VALMHDR(1)="From "_$$FMTE^XLFDT(SRCH("ADATE"))_" to "_$$FMTE^XLFDT(SRCH("BDATE"))
S VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",(IOM-$L(VALMHDR(1)))/2,$L(VALMHDR(1)))
S VALMHDR(1)="Search Criteria: "_$E(VALMHDR(1),17,80)
S VALMHDR(2)=""
N HDR S HDR="BDATE" F S HDR=$O(SRCH(HDR)) Q:HDR="" D
. S VALMHDR(2)=VALMHDR(2)_$S(HDR="CDL":"CLIN DANGER LVL",HDR="ORDCHECK":"ORDER CHK",HDR="ORDITEM":"ORDERABLE ITEM",1:HDR)_$S($O(SRCH(HDR))'="":",",1:"")
S VALMHDR(2)=$$SETSTR^VALM1(VALMHDR(2),"",(IOM-$L(VALMHDR(2)))/2,$L(VALMHDR(2)))
D XQORM
Q
CHANGE ;
D FULL^VALM1 W @IOF
S CONT=0 K SRCH
D LM^ORNORC ; setup search parameters from user
I '+CONT W !!,"Search parameter entry aborted.",! Q
S VALMCNT=0 K @LOC D CLEAN^VALM10
D FIND^ORNORC(.SRCH,LOC) ; find entries that match search criteria
D HDR,INIT,RE^VALM4
Q
ASK ;
D VIEW ; default action
Q
INIT ;
N GBL,IEN S GBL=$NA(^OR(100.3))
K @VALMAR
S (VALMCNT,IEN)=0 F S IEN=$O(@LOC@(IEN)) Q:'+IEN D
. N DATE,OCC,ORDER,VALUE,X S X="",OCC=$$GET1^DIQ(100.3,IEN_",",.05,"I")
. S VALMCNT=VALMCNT+1
. S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
. S ORDER=$$GET1^DIQ(100.3,IEN,.07)
. S VALUE=$E($S('+ORDER:$$GET1^DIQ(100.3,IEN,.02),+ORDER:$$GET1^DIQ(100,ORDER,.02)),1,20)
. S X=$$SETFLD^VALM1(VALUE,X,"PATIENT")
. S VALUE=$E($S(OCC="CH":$$GET1^DIQ(100.31,"1,"_IEN,.01),'+ORDER:$$GET1^DIQ(100.31,"1,"_IEN,.01),+ORDER:$$GET1^DIQ(100.001,"1,"_ORDER,.01)),1,48)
. I +$D(^OR(100.3,IEN,1,2)) S VALUE=VALUE_" *"
. I +ORDER,VALUE'["*",+$D(^OR(100,ORDER,.1,2)) S VALUE=VALUE_" *"
. S X=$$SETFLD^VALM1(VALUE,X,"ORDERABLE ITEM")
. S DATE=$$FIXDT($$FMTE^XLFDT($E($$GET1^DIQ(100.3,IEN,.01,"I"),1,12),2))
. S X=$$SETFLD^VALM1(DATE,X,"DATE")
. I '+ORDER D
. . S VALUE=$$GET1^DIQ(100.32,"1,"_IEN,.01)
. . I +$D(^OR(100.3,IEN,2,2)) S VALUE=VALUE_" *"
. . S X=$$SETFLD^VALM1($E(VALUE,1,50),X,"ORDER CHECK")
. . S VALUE=$$GET1^DIQ(100.32,"1,"_IEN,.02)
. . S X=$$SETFLD^VALM1(VALUE,X,"CDL")
. . S X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.03),X,"ENTERED")
. I +ORDER D
. . S X=$$SETFLD^VALM1($$GET1^DIQ(100,ORDER,.02),X,"PATIENT")
. . S X=$$SETFLD^VALM1($$GET1^DIQ(100,ORDER,3),X,"ENTERED")
. . N ORCHK D GETOC2^OROCAPI1(ORDER,.ORCHK)
. . S ORCHK="",ORCHK=$O(ORCHK(ORDER,ORCHK))
. . S VALUE=$$GET1^DIQ(100.05,ORCHK,5)
. . I +$O(ORCHK(ORDER,ORCHK)) S VALUE=VALUE_" *"
. . S X=$$SETFLD^VALM1($E(VALUE,1,50),X,"ORDER CHECK")
. . S VALUE=$$GET1^DIQ(100.05,ORCHK,6)
. . S X=$$SETFLD^VALM1(VALUE,X,"CDL")
. S X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.03),X,"USER")
. S X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.05),X,"OCCURRENCE")
. D SET^VALM10(VALMCNT,X,IEN)
I VALMCNT=0 S VALMCNT=1 D
. D SET^VALM10(1," ",0)
. S X="No records found to satisfy search criteria."
. S X=$$SETSTR^VALM1(X,"",(IOM-$L(X))/2,$L(X))
. D SET^VALM10(2,X,0)
. S VALMCNT=0
Q
HELP ;
N DIR
I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
D FULL^VALM1
W !!,"* indicates there are multiple entries for this item."
W !!,"The following actions are available:"
W !!,"View Order - View Order Details Change Search - Change Search Parameters"
W !
I $D(DIR("A")) D ^DIR
S VALMBCK="R"
Q
EXIT ;
D XQORM
Q
EXPND ;
Q
SELECT(ACT) ;
I ACT="CHANGE" G CHANGE
I VALMCNT=0 Q
N SEL,X,Y
D FULL^VALM1
S SEL=+$P(XQORNOD(0),"=",2)
I SEL=0 S SEL=+$$READ("N^1:"_VALMLST_":0","Select Order") Q:'+SEL
D @ACT
Q
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
N DIR,X,Y
S DIR(0)=TYPE
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
D ^DIR
I $G(X)="@" S Y="@" Q Y
I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
Q Y
XQORM ;
S XQORM("#")=$O(^ORD(101,"B","ORCHK LISTMAN SELECT ENTRY",0))_U_"1:"_VALMCNT
Q
FIXDT(X) ;
S $P(X,"/")=$S($P(X,"/")<10:"0"_$P(X,"/"),1:$P(X,"/"))
S $P(X,"/",2)=$S($P(X,"/",2)<10:"0"_$P(X,"/",2),1:$P(X,"/",2))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOROCLM 7199 printed Oct 16, 2024@18:32:54 Page 2
OROCLM ; SLC/AJB - ListManager Display for Cancelled Orders ;May 17, 2018@12:28
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
+2 QUIT
VIEW ;
+1 NEW DATA,IEN,ORDER,X
+2 DO FULL^VALM1
WRITE @IOF
+3 SET IEN=$ORDER(@VALMAR@("IDX",SEL,""))
+4 SET ORDER=$$GET1^DIQ(100.3,IEN,.07)
+5 SET DATA("DATE")=$$FIXDT($$FMTE^XLFDT($EXTRACT($$GET1^DIQ(100.3,IEN,.01,"I"),1,12),2))
+6 SET DATA("PATIENT")=$SELECT('+ORDER:$$GET1^DIQ(100.3,IEN,.02),+ORDER:$$GET1^DIQ(100,ORDER,.02))
+7 SET DATA("ENTERED")=$SELECT('+ORDER:$$GET1^DIQ(100.3,IEN,.03),+ORDER:$$GET1^DIQ(100,ORDER,3))
+8 SET DATA("USER")=$$GET1^DIQ(100.3,IEN,.03)
+9 SET DATA("OCCURRENCE")=$$GET1^DIQ(100.3,IEN,.05)
+10 SET X=0
+11 ;,$P(DATA(X),U,2)="IORVON",$P(DATA(X),U,3)="IORVOFF"
SET X=X+1
SET DATA(X)="Cancelled Order Information"
SET DATA(X)=$$SETSTR^VALM1(DATA(X),"",IOM-$LENGTH(DATA(X))/2,$LENGTH(DATA(X)))
+12 ;
+13 SET X=X+1
SET DATA(X)="Date/Time"
SET DATA(X)=$$SETSTR^VALM1("Patient Name",DATA(X),IOM-12/2,12)
SET DATA(X)=$$SETSTR^VALM1("Occurrence",DATA(X),IOM-9,10)
+14 ;
+15 SET X=X+1
SET DATA(X)=DATA("DATE")
SET DATA(X)=$$SETSTR^VALM1(DATA("PATIENT"),DATA(X),IOM-$LENGTH(DATA("PATIENT"))/2,$LENGTH(DATA("PATIENT")))
+16 SET DATA(X)=$$SETSTR^VALM1(DATA("OCCURRENCE"),DATA(X),IOM-($LENGTH(DATA("OCCURRENCE"))-1),$LENGTH(DATA("OCCURRENCE")))
SET $PIECE(DATA(X),U,2)="IOUON"
SET $PIECE(DATA(X),U,3)="IOUOFF"
+17 ;
+18 SET X=X+1
SET DATA(X)=""
+19 SET X=X+1
SET DATA(X)="Orderable Item(s)"
SET $PIECE(DATA(X),U,2)="IORVON"
SET $PIECE(DATA(X),U,3)="IORVOFF"
+20 ;
+21 Begin DoDot:1
+22 NEW CNT,FILE,FLDS,OCC,OUT,ORCHK
+23 SET OCC=$$GET1^DIQ(100.3,IEN_",",.05,"I")
+24 SET FILE=$SELECT(OCC="CH":100.3,+ORDER:100,1:100.3)
+25 SET FLDS=$SELECT(FILE=100:".1*",1:"1*;2*")
+26 DO GETS^DIQ(FILE,$SELECT(OCC="CH":IEN,+ORDER:ORDER,1:IEN)_",",FLDS,"NE","OUT")
+27 ; orderable items
IF +$DATA(OUT)
SET OUT=0
SET FILE=$ORDER(OUT(FILE))
FOR
SET OUT=$ORDER(OUT(FILE,OUT))
if '+OUT
QUIT
SET X=X+1
SET DATA(X)=OUT(FILE,OUT,.01,"E")
+28 ;
+29 SET FILE=$SELECT(OCC="CH":100.32,+ORDER:100.05,1:100.32)
IF +ORDER
Begin DoDot:2
+30 NEW ORCHK
DO GETOC2^OROCAPI1(ORDER,.ORCHK)
+31 SET ORCHK=0
FOR
SET ORCHK=$ORDER(ORCHK(ORDER,ORCHK))
if '+ORCHK
QUIT
DO GETS^DIQ(FILE,ORCHK_",","5;6;8","E","OUT")
End DoDot:2
+32 SET (CNT,OUT)=0
+33 FOR
SET OUT=$ORDER(OUT(FILE,OUT))
if '+OUT
QUIT
Begin DoDot:2
+34 SET CNT=CNT+1
+35 ;,$P(DATA(X),U,2)="IORVON",$P(DATA(X),U,3)="IORVOFF"
IF CNT=1
SET X=X+1
SET DATA(X)=""
SET X=X+1
SET DATA(X)="Order Check Information"
SET DATA(X)=$$SETSTR^VALM1(DATA(X),"",IOM-$LENGTH(DATA(X))/2,$LENGTH(DATA(X)))
+36 IF CNT=1
SET X=X+1
SET DATA(X)="Type"
+37 IF CNT=1
SET X=X+1
SET DATA(X)="Message"
SET DATA(X)=$$SETSTR^VALM1("Clinical Danger Level",DATA(X),40,41)
SET $PIECE(DATA(X),U,2)="IOUON"
SET $PIECE(DATA(X),U,3)="IOUOFF"
+38 ;
+39 SET X=X+1
SET DATA(X)=OUT(FILE,OUT,$SELECT(OCC="CH":.01,+ORDER:5,1:.01),"E")
SET DATA(X)=$$SETSTR^VALM1(OUT(FILE,OUT,$SELECT(OCC="CH":.02,+ORDER:6,1:.02),"E"),DATA(X),40,41)
+40 ; S X=X+1,DATA(X)=""
IF '+ORDER!(OCC="CH")
SET X=X+1
SET DATA(X)=OUT(FILE,OUT,1,"E")
+41 ;
+42 NEW I
SET I=0
FOR
SET I=$ORDER(OUT(FILE,OUT,$SELECT(OCC="CH":2,+ORDER:8,1:2),I))
if '+I
QUIT
SET X=X+1
SET DATA(X)=OUT(FILE,OUT,$SELECT(OCC="CH":2,+ORDER:8,1:2),I)
+43 SET X=X+1
SET DATA(X)=""
End DoDot:2
End DoDot:1
+44 ;
+45 SET X=0
FOR
SET X=$ORDER(DATA(X))
if '+X
QUIT
Begin DoDot:1
+46 if X>1
WRITE !
IF $Y>(IOSL-3)
IF $$READ("EA",IORVON_"Press <ENTER> to continue..."_IORVOFF)
WRITE @IOF
+47 if $PIECE(DATA(X),U,2)'=""
WRITE @$PIECE(DATA(X),U,2)
WRITE $PIECE(DATA(X),U)
if $PIECE(DATA(X),U,3)'=""
WRITE @$PIECE(DATA(X),U,3)
End DoDot:1
+48 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+49 IF $$READ("EA",IORVON_"Press <ENTER> to continue..."_IORVOFF)
+50 QUIT
EN(SRCH,LOC) ;
+1 DO EN^VALM("OR ORDER CHECKS DISPLAY")
+2 QUIT
HDR ;
+1 SET VALMHDR(1)="From "_$$FMTE^XLFDT(SRCH("ADATE"))_" to "_$$FMTE^XLFDT(SRCH("BDATE"))
+2 SET VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",(IOM-$LENGTH(VALMHDR(1)))/2,$LENGTH(VALMHDR(1)))
+3 SET VALMHDR(1)="Search Criteria: "_$EXTRACT(VALMHDR(1),17,80)
+4 SET VALMHDR(2)=""
+5 NEW HDR
SET HDR="BDATE"
FOR
SET HDR=$ORDER(SRCH(HDR))
if HDR=""
QUIT
Begin DoDot:1
+6 SET VALMHDR(2)=VALMHDR(2)_$SELECT(HDR="CDL":"CLIN DANGER LVL",HDR="ORDCHECK":"ORDER CHK",HDR="ORDITEM":"ORDERABLE ITEM",1:HDR)_$SELECT($ORDER(SRCH(HDR))'="":",",1:"")
End DoDot:1
+7 SET VALMHDR(2)=$$SETSTR^VALM1(VALMHDR(2),"",(IOM-$LENGTH(VALMHDR(2)))/2,$LENGTH(VALMHDR(2)))
+8 DO XQORM
+9 QUIT
CHANGE ;
+1 DO FULL^VALM1
WRITE @IOF
+2 SET CONT=0
KILL SRCH
+3 ; setup search parameters from user
DO LM^ORNORC
+4 IF '+CONT
WRITE !!,"Search parameter entry aborted.",!
QUIT
+5 SET VALMCNT=0
KILL @LOC
DO CLEAN^VALM10
+6 ; find entries that match search criteria
DO FIND^ORNORC(.SRCH,LOC)
+7 DO HDR
DO INIT
DO RE^VALM4
+8 QUIT
ASK ;
+1 ; default action
DO VIEW
+2 QUIT
INIT ;
+1 NEW GBL,IEN
SET GBL=$NAME(^OR(100.3))
+2 KILL @VALMAR
+3 SET (VALMCNT,IEN)=0
FOR
SET IEN=$ORDER(@LOC@(IEN))
if '+IEN
QUIT
Begin DoDot:1
+4 NEW DATE,OCC,ORDER,VALUE,X
SET X=""
SET OCC=$$GET1^DIQ(100.3,IEN_",",.05,"I")
+5 SET VALMCNT=VALMCNT+1
+6 SET X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
+7 SET ORDER=$$GET1^DIQ(100.3,IEN,.07)
+8 SET VALUE=$EXTRACT($SELECT('+ORDER:$$GET1^DIQ(100.3,IEN,.02),+ORDER:$$GET1^DIQ(100,ORDER,.02)),1,20)
+9 SET X=$$SETFLD^VALM1(VALUE,X,"PATIENT")
+10 SET VALUE=$EXTRACT($SELECT(OCC="CH":$$GET1^DIQ(100.31,"1,"_IEN,.01),'+ORDER:$$GET1^DIQ(100.31,"1,"_IEN,.01),+ORDER:$$GET1^DIQ(100.001,"1,"_ORDER,.01)),1,48)
+11 IF +$DATA(^OR(100.3,IEN,1,2))
SET VALUE=VALUE_" *"
+12 IF +ORDER
IF VALUE'["*"
IF +$DATA(^OR(100,ORDER,.1,2))
SET VALUE=VALUE_" *"
+13 SET X=$$SETFLD^VALM1(VALUE,X,"ORDERABLE ITEM")
+14 SET DATE=$$FIXDT($$FMTE^XLFDT($EXTRACT($$GET1^DIQ(100.3,IEN,.01,"I"),1,12),2))
+15 SET X=$$SETFLD^VALM1(DATE,X,"DATE")
+16 IF '+ORDER
Begin DoDot:2
+17 SET VALUE=$$GET1^DIQ(100.32,"1,"_IEN,.01)
+18 IF +$DATA(^OR(100.3,IEN,2,2))
SET VALUE=VALUE_" *"
+19 SET X=$$SETFLD^VALM1($EXTRACT(VALUE,1,50),X,"ORDER CHECK")
+20 SET VALUE=$$GET1^DIQ(100.32,"1,"_IEN,.02)
+21 SET X=$$SETFLD^VALM1(VALUE,X,"CDL")
+22 SET X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.03),X,"ENTERED")
End DoDot:2
+23 IF +ORDER
Begin DoDot:2
+24 SET X=$$SETFLD^VALM1($$GET1^DIQ(100,ORDER,.02),X,"PATIENT")
+25 SET X=$$SETFLD^VALM1($$GET1^DIQ(100,ORDER,3),X,"ENTERED")
+26 NEW ORCHK
DO GETOC2^OROCAPI1(ORDER,.ORCHK)
+27 SET ORCHK=""
SET ORCHK=$ORDER(ORCHK(ORDER,ORCHK))
+28 SET VALUE=$$GET1^DIQ(100.05,ORCHK,5)
+29 IF +$ORDER(ORCHK(ORDER,ORCHK))
SET VALUE=VALUE_" *"
+30 SET X=$$SETFLD^VALM1($EXTRACT(VALUE,1,50),X,"ORDER CHECK")
+31 SET VALUE=$$GET1^DIQ(100.05,ORCHK,6)
+32 SET X=$$SETFLD^VALM1(VALUE,X,"CDL")
End DoDot:2
+33 SET X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.03),X,"USER")
+34 SET X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.05),X,"OCCURRENCE")
+35 DO SET^VALM10(VALMCNT,X,IEN)
End DoDot:1
+36 IF VALMCNT=0
SET VALMCNT=1
Begin DoDot:1
+37 DO SET^VALM10(1," ",0)
+38 SET X="No records found to satisfy search criteria."
+39 SET X=$$SETSTR^VALM1(X,"",(IOM-$LENGTH(X))/2,$LENGTH(X))
+40 DO SET^VALM10(2,X,0)
+41 SET VALMCNT=0
End DoDot:1
+42 QUIT
HELP ;
+1 NEW DIR
+2 IF X="?"
SET DIR("A")="Enter RETURN to continue or '^' to exit"
SET DIR(0)="E"
+3 DO FULL^VALM1
+4 WRITE !!,"* indicates there are multiple entries for this item."
+5 WRITE !!,"The following actions are available:"
+6 WRITE !!,"View Order - View Order Details Change Search - Change Search Parameters"
+7 WRITE !
+8 IF $DATA(DIR("A"))
DO ^DIR
+9 SET VALMBCK="R"
+10 QUIT
EXIT ;
+1 DO XQORM
+2 QUIT
EXPND ;
+1 QUIT
SELECT(ACT) ;
+1 IF ACT="CHANGE"
GOTO CHANGE
+2 IF VALMCNT=0
QUIT
+3 NEW SEL,X,Y
+4 DO FULL^VALM1
+5 SET SEL=+$PIECE(XQORNOD(0),"=",2)
+6 IF SEL=0
SET SEL=+$$READ("N^1:"_VALMLST_":0","Select Order")
if '+SEL
QUIT
+7 DO @ACT
+8 QUIT
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
+1 NEW DIR,X,Y
+2 SET DIR(0)=TYPE
+3 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+4 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+5 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+6 IF $DATA(HELP)
SET DIR("?")=HELP
+7 DO ^DIR
+8 IF $GET(X)="@"
SET Y="@"
QUIT Y
+9 IF Y]""
IF ($LENGTH($GET(Y),U)'=2)
SET Y=Y_U_$GET(Y(0),Y)
+10 QUIT Y
XQORM ;
+1 SET XQORM("#")=$ORDER(^ORD(101,"B","ORCHK LISTMAN SELECT ENTRY",0))_U_"1:"_VALMCNT
+2 QUIT
FIXDT(X) ;
+1 SET $PIECE(X,"/")=$SELECT($PIECE(X,"/")<10:"0"_$PIECE(X,"/"),1:$PIECE(X,"/"))
+2 SET $PIECE(X,"/",2)=$SELECT($PIECE(X,"/",2)<10:"0"_$PIECE(X,"/",2),1:$PIECE(X,"/",2))
+3 QUIT X
