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

OROCLM.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. VIEW ;
  1. N DATA,IEN,ORDER,X
  1. D FULL^VALM1 W @IOF
  1. S IEN=$O(@VALMAR@("IDX",SEL,""))
  1. S ORDER=$$GET1^DIQ(100.3,IEN,.07)
  1. S DATA("DATE")=$$FIXDT($$FMTE^XLFDT($E($$GET1^DIQ(100.3,IEN,.01,"I"),1,12),2))
  1. S DATA("PATIENT")=$S('+ORDER:$$GET1^DIQ(100.3,IEN,.02),+ORDER:$$GET1^DIQ(100,ORDER,.02))
  1. S DATA("ENTERED")=$S('+ORDER:$$GET1^DIQ(100.3,IEN,.03),+ORDER:$$GET1^DIQ(100,ORDER,3))
  1. S DATA("USER")=$$GET1^DIQ(100.3,IEN,.03)
  1. S DATA("OCCURRENCE")=$$GET1^DIQ(100.3,IEN,.05)
  1. S X=0
  1. 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"
  1. ;
  1. 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)
  1. ;
  1. S X=X+1,DATA(X)=DATA("DATE"),DATA(X)=$$SETSTR^VALM1(DATA("PATIENT"),DATA(X),IOM-$L(DATA("PATIENT"))/2,$L(DATA("PATIENT")))
  1. 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"
  1. ;
  1. S X=X+1,DATA(X)=""
  1. S X=X+1,DATA(X)="Orderable Item(s)",$P(DATA(X),U,2)="IORVON",$P(DATA(X),U,3)="IORVOFF"
  1. ;
  1. D
  1. . N CNT,FILE,FLDS,OCC,OUT,ORCHK
  1. . S OCC=$$GET1^DIQ(100.3,IEN_",",.05,"I")
  1. . S FILE=$S(OCC="CH":100.3,+ORDER:100,1:100.3)
  1. . S FLDS=$S(FILE=100:".1*",1:"1*;2*")
  1. . D GETS^DIQ(FILE,$S(OCC="CH":IEN,+ORDER:ORDER,1:IEN)_",",FLDS,"NE","OUT")
  1. . 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
  1. . ;
  1. . S FILE=$S(OCC="CH":100.32,+ORDER:100.05,1:100.32) I +ORDER D
  1. . . N ORCHK D GETOC2^OROCAPI1(ORDER,.ORCHK)
  1. . . S ORCHK=0 F S ORCHK=$O(ORCHK(ORDER,ORCHK)) Q:'+ORCHK D GETS^DIQ(FILE,ORCHK_",","5;6;8","E","OUT")
  1. . S (CNT,OUT)=0
  1. . F S OUT=$O(OUT(FILE,OUT)) Q:'+OUT D
  1. . . S CNT=CNT+1
  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"
  1. . . I CNT=1 S X=X+1,DATA(X)="Type"
  1. . . 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"
  1. . . ;
  1. . . 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)
  1. . . I '+ORDER!(OCC="CH") S X=X+1,DATA(X)=OUT(FILE,OUT,1,"E") ; S X=X+1,DATA(X)=""
  1. . . ;
  1. . . 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)
  1. . . S X=X+1,DATA(X)=""
  1. ;
  1. S X=0 F S X=$O(DATA(X)) Q:'+X D
  1. . W:X>1 ! I $Y>(IOSL-3) I $$READ("EA",IORVON_"Press <ENTER> to continue..."_IORVOFF) W @IOF
  1. . 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)
  1. F Q:$Y>(IOSL-3) W !
  1. I $$READ("EA",IORVON_"Press <ENTER> to continue..."_IORVOFF)
  1. Q
  1. EN(SRCH,LOC) ;
  1. D EN^VALM("OR ORDER CHECKS DISPLAY")
  1. Q
  1. HDR ;
  1. S VALMHDR(1)="From "_$$FMTE^XLFDT(SRCH("ADATE"))_" to "_$$FMTE^XLFDT(SRCH("BDATE"))
  1. S VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",(IOM-$L(VALMHDR(1)))/2,$L(VALMHDR(1)))
  1. S VALMHDR(1)="Search Criteria: "_$E(VALMHDR(1),17,80)
  1. S VALMHDR(2)=""
  1. N HDR S HDR="BDATE" F S HDR=$O(SRCH(HDR)) Q:HDR="" D
  1. . 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:"")
  1. S VALMHDR(2)=$$SETSTR^VALM1(VALMHDR(2),"",(IOM-$L(VALMHDR(2)))/2,$L(VALMHDR(2)))
  1. D XQORM
  1. Q
  1. CHANGE ;
  1. D FULL^VALM1 W @IOF
  1. S CONT=0 K SRCH
  1. D LM^ORNORC ; setup search parameters from user
  1. I '+CONT W !!,"Search parameter entry aborted.",! Q
  1. S VALMCNT=0 K @LOC D CLEAN^VALM10
  1. D FIND^ORNORC(.SRCH,LOC) ; find entries that match search criteria
  1. D HDR,INIT,RE^VALM4
  1. Q
  1. ASK ;
  1. D VIEW ; default action
  1. Q
  1. INIT ;
  1. N GBL,IEN S GBL=$NA(^OR(100.3))
  1. K @VALMAR
  1. S (VALMCNT,IEN)=0 F S IEN=$O(@LOC@(IEN)) Q:'+IEN D
  1. . N DATE,OCC,ORDER,VALUE,X S X="",OCC=$$GET1^DIQ(100.3,IEN_",",.05,"I")
  1. . S VALMCNT=VALMCNT+1
  1. . S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
  1. . S ORDER=$$GET1^DIQ(100.3,IEN,.07)
  1. . S VALUE=$E($S('+ORDER:$$GET1^DIQ(100.3,IEN,.02),+ORDER:$$GET1^DIQ(100,ORDER,.02)),1,20)
  1. . S X=$$SETFLD^VALM1(VALUE,X,"PATIENT")
  1. . 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)
  1. . I +$D(^OR(100.3,IEN,1,2)) S VALUE=VALUE_" *"
  1. . I +ORDER,VALUE'["*",+$D(^OR(100,ORDER,.1,2)) S VALUE=VALUE_" *"
  1. . S X=$$SETFLD^VALM1(VALUE,X,"ORDERABLE ITEM")
  1. . S DATE=$$FIXDT($$FMTE^XLFDT($E($$GET1^DIQ(100.3,IEN,.01,"I"),1,12),2))
  1. . S X=$$SETFLD^VALM1(DATE,X,"DATE")
  1. . I '+ORDER D
  1. . . S VALUE=$$GET1^DIQ(100.32,"1,"_IEN,.01)
  1. . . I +$D(^OR(100.3,IEN,2,2)) S VALUE=VALUE_" *"
  1. . . S X=$$SETFLD^VALM1($E(VALUE,1,50),X,"ORDER CHECK")
  1. . . S VALUE=$$GET1^DIQ(100.32,"1,"_IEN,.02)
  1. . . S X=$$SETFLD^VALM1(VALUE,X,"CDL")
  1. . . S X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.03),X,"ENTERED")
  1. . I +ORDER D
  1. . . S X=$$SETFLD^VALM1($$GET1^DIQ(100,ORDER,.02),X,"PATIENT")
  1. . . S X=$$SETFLD^VALM1($$GET1^DIQ(100,ORDER,3),X,"ENTERED")
  1. . . N ORCHK D GETOC2^OROCAPI1(ORDER,.ORCHK)
  1. . . S ORCHK="",ORCHK=$O(ORCHK(ORDER,ORCHK))
  1. . . S VALUE=$$GET1^DIQ(100.05,ORCHK,5)
  1. . . I +$O(ORCHK(ORDER,ORCHK)) S VALUE=VALUE_" *"
  1. . . S X=$$SETFLD^VALM1($E(VALUE,1,50),X,"ORDER CHECK")
  1. . . S VALUE=$$GET1^DIQ(100.05,ORCHK,6)
  1. . . S X=$$SETFLD^VALM1(VALUE,X,"CDL")
  1. . S X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.03),X,"USER")
  1. . S X=$$SETFLD^VALM1($$GET1^DIQ(100.3,IEN,.05),X,"OCCURRENCE")
  1. . D SET^VALM10(VALMCNT,X,IEN)
  1. I VALMCNT=0 S VALMCNT=1 D
  1. . D SET^VALM10(1," ",0)
  1. . S X="No records found to satisfy search criteria."
  1. . S X=$$SETSTR^VALM1(X,"",(IOM-$L(X))/2,$L(X))
  1. . D SET^VALM10(2,X,0)
  1. . S VALMCNT=0
  1. Q
  1. HELP ;
  1. N DIR
  1. I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
  1. D FULL^VALM1
  1. W !!,"* indicates there are multiple entries for this item."
  1. W !!,"The following actions are available:"
  1. W !!,"View Order - View Order Details Change Search - Change Search Parameters"
  1. W !
  1. I $D(DIR("A")) D ^DIR
  1. S VALMBCK="R"
  1. Q
  1. EXIT ;
  1. D XQORM
  1. Q
  1. EXPND ;
  1. Q
  1. SELECT(ACT) ;
  1. I ACT="CHANGE" G CHANGE
  1. I VALMCNT=0 Q
  1. N SEL,X,Y
  1. D FULL^VALM1
  1. S SEL=+$P(XQORNOD(0),"=",2)
  1. I SEL=0 S SEL=+$$READ("N^1:"_VALMLST_":0","Select Order") Q:'+SEL
  1. D @ACT
  1. Q
  1. READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
  1. N DIR,X,Y
  1. S DIR(0)=TYPE
  1. I $D(SCREEN) S DIR("S")=SCREEN
  1. I $G(PROMPT)]"" S DIR("A")=PROMPT
  1. I $G(DEFAULT)]"" S DIR("B")=DEFAULT
  1. I $D(HELP) S DIR("?")=HELP
  1. D ^DIR
  1. I $G(X)="@" S Y="@" Q Y
  1. I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
  1. Q Y
  1. XQORM ;
  1. S XQORM("#")=$O(^ORD(101,"B","ORCHK LISTMAN SELECT ENTRY",0))_U_"1:"_VALMCNT
  1. Q
  1. FIXDT(X) ;
  1. S $P(X,"/")=$S($P(X,"/")<10:"0"_$P(X,"/"),1:$P(X,"/"))
  1. S $P(X,"/",2)=$S($P(X,"/",2)<10:"0"_$P(X,"/",2),1:$P(X,"/",2))
  1. Q X