- 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 Jan 18, 2025@03:33:28 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