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

ORX1.m

Go to the documentation of this file.
  1. ORX1 ; SLC/DCM - OE/RR Nature of Order entry points ;Apr 24, 2024@07:20:01
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242,535**;Dec 17, 1997;Build 20
  1. ;Reference to ^DIC(9.4,"C" in ICR #2058
  1. ;Reference to ^DIC in ICR #10006
  1. ;Reference to MIX^DIC1 in ICR #10007
  1. ;Reference to ^DIE in ICR #10018
  1. ;Reference to ^DIR in ICR #10026
  1. ;
  1. NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order
  1. ;DEFAULT [not required] =Free text code or pointer to Nature of order (file 100.02).
  1. ; Used for default response.
  1. ;REQUIRD [not required] =1 to require a response from user,
  1. ; =0 (default) not to require response.
  1. ;FB [not required] =F for frontdoor,
  1. ; =B (default) for backdoor.
  1. ; Screens on Frontdoor/Backdoor types.
  1. ; Nature of order entries are setup to be available for
  1. ; frontdoor or backdoor processing.
  1. ;DIRA [not required] =prompt for DIR("A")
  1. ; default:"Reason for Order/Change"
  1. ;DC [not required] =1 if you want to include 'DC only' types,
  1. ; =0 (default) includes all other types except for 'DC only'.
  1. ;LIST [not required] =List of 'Nature of Order' codes (from file 100.02)
  1. ; allowed. If this is passed, then DC and FB params
  1. ; are ignored. Format: code1code2code3
  1. ;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS")
  1. ;Returned value: ifn^name^code
  1. N DIR,X,Y,DIRUT,DUOUT
  1. S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
  1. S DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the"
  1. S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
  1. S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
  1. S DIR("?",5)=""
  1. S DIR("?",6)=" Enter '??' for more information."
  1. S DIR("?")=" "
  1. S DIR("A")=$S($L($G(DIRA)):DIRA,1:"Reason for Order/Change")
  1. I '$G(DEFAULT),$L($G(DEFAULT)),$O(^ORD(100.02,"C",DEFAULT,0)) S DEFAULT=$O(^(0))
  1. I $G(DEFAULT) S DIR("B")=$S($D(^ORD(100.02,+DEFAULT,0)):$S('$L($G(LIST)):$P(^(0),"^"),1:$S($L($G(LIST))&($G(LIST)[$P(^(0),"^",2)):$P(^(0),"^"),1:""),1:""),1:"") K:DIR("B")="" DIR("B")
  1. S DIR(0)="P^100.02:EMZ"
  1. S:'$D(FB) FB="B" S:FB="" FB="B" S:'$D(DC) DC=0
  1. I $L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0),""^"",2)"
  1. I '$L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),('$P(^(0),""^"",6)!(DC)),"_$S(FB="B":"""XB""[$P(^(0),""^"",5)",FB="F":"""XF""[$P(^(0),""^"",5)",1:0)
  1. S DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
  1. S DIR("??")="^D NA1^ORX1(DIR(""S""))"
  1. OT2 D ^DIR
  1. I 'Y,$G(REQUIRD)=1 W !,"A "_$S($L($G(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$C(7),! G OT2
  1. I Y S $P(Y,"^",3)=$P(^ORD(100.02,+Y,0),"^",2)
  1. Q Y
  1. NA1(SCREEN) ;Executable help for Nature of order
  1. ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
  1. N X,X1,Y
  1. W !?30," Require",?43," Print",?56,"Print on"
  1. W !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
  1. W !?2,"------------------------",?29,"-----------",?43,"----------",?56,"--------"
  1. S Y=0 F S Y=$O(^ORD(100.02,Y)) Q:Y<1 I $D(^(Y,0)) X:$D(SCREEN) SCREEN I $T S X=^ORD(100.02,Y,0),X1=$G(^(1)) W !,?2,$P(X,"^"),?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
  1. Q
  1. NA2(SCREEN) ;Get help for DC Reasons
  1. ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
  1. N X,X1,I
  1. W !?30," Require",?43," Print",?56,"Print on"
  1. W !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
  1. W !,"------------",?29,"-----------",?43,"----------",?56,"--------"
  1. S I=0 F S I=$O(^ORD(100.03,I)) Q:I<1 I $D(^(I,0)) X:$D(SCREEN) SCREEN I $T S X=^(0) I $P(X,"^",7),$D(^ORD(100.02,$P(X,"^",7),0)) W !,$P(X,"^") S X=^(0),X1=$G(^(1)) D
  1. . W ?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
  1. Q
  1. ;
  1. CREATE(X) ; -- Returns 1 or 0, if action should be created or not
  1. N Y Q:'$L($G(X)) 0
  1. I 'X S X=+$O(^ORD(100.02,"C",X,0))
  1. S Y=+$P($G(^ORD(100.02,+X,1)),U)
  1. Q Y
  1. ;
  1. SIGSTS(X) ; -- Returns default signature status for nature X
  1. N Y S Y="" G:'$L($G(X)) SIGQ
  1. I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X SIGQ
  1. S Y=$P($G(^ORD(100.02,+X,1)),U,4)
  1. SIGQ Q Y
  1. ;
  1. CHART(X) ; -- Returns 1 or 0, print chart copy for nature X
  1. N Y S Y="" G:'$L($G(X)) CHQ
  1. I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X CHQ
  1. S Y=$P($G(^ORD(100.02,+X,1)),U,2)
  1. CHQ Q Y
  1. ;
  1. ACTV(X) ; -- Returns 1 or 0, include action in Active Orders
  1. N Y S Y="" G:'$L($G(X)) ACTQ
  1. I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X ACTQ
  1. S Y=$P($G(^ORD(100.02,+X,1)),U,6)
  1. ACTQ Q Y
  1. ;
  1. DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason
  1. ;DEFAULT=ifn of default reason
  1. ;REQ=1 to require a response
  1. ;PKG=ptr to file 9.4 to only get reasons for a specific package
  1. ;DIRA=Default prompt to be used instead of DIR("A")
  1. N DIR,X,Y,DIRUT,DUOUT
  1. S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
  1. S DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the"
  1. S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
  1. S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
  1. S DIR("?",5)=""
  1. S DIR("?")=" "
  1. S DIR("A")="Reason" I $L($G(DIRA)) S DIR("A")=DIRA
  1. I $G(DEFAULT) S DIR("B")=$S($G(DEFAULT):$S($D(^ORD(100.03,+DEFAULT,0)):$P(^(0),"^"),1:""),1:"")
  1. S DIR(0)="P^100.03:EMZ"
  1. S DIR("S")="I '$P(^(0),""^"",4)"_$S($G(PKG):",$P(^(0),""^"",5)=PKG",1:"")
  1. S DIR("??")="^D NA2^ORX1(DIR(""S""))"
  1. OT1 D ^DIR
  1. I 'Y,$G(REQ)=1 W !,"A REASON FOR DC must be entered",$C(7),! G OT1
  1. Q $S(Y:+Y_"^"_$G(Y(0)),1:Y)
  1. ;
  1. EDITDCR ; -- Edit DC Reason
  1. N X,Y,D,DIC,DIE,DR,DA,DLAYGO W !
  1. EDC1 S DIC=100.03,DIC(0)="AELNQM",DIC("A")="Select DC REASON: ",DLAYGO=100.03
  1. S DIC("S")="I $P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0)),D="B^S"
  1. S DIC("DR")=".05////"_+$O(^DIC(9.4,"C","OR",0)) D MIX^DIC1 Q:Y'>0
  1. S DA=+Y,DIE=DIC,DR=".01;.03;.04;.07" D ^DIE
  1. W ! G EDC1
  1. Q
  1. ;
  1. EDITNAT ; -- Edit allowable Nature of Order fields
  1. N X,Y,DA,DR,DIE,DIC W !
  1. EDN S DIC="^ORD(100.02,",DIC(0)="AEQM",DIC("A")="Select NATURE OF ORDER: "
  1. S DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
  1. D ^DIC Q:Y<1
  1. S DA=+Y,DIE=DIC,DR=".12;.13;.15;.16" D ^DIE
  1. W ! G EDN
  1. Q
  1. ;
  1. EDITOVR ; -- Edit Override Reason
  1. N X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,NATIONAL W !
  1. EOVR1 S DIC=100.04,DIC(0)="AELNQ",DIC("A")="Select OVERRIDE REASON: ",DLAYGO=100.04,DIC("DR")=".01"
  1. D ^DIC Q:Y'>0
  1. S NATIONAL=+$P($G(^ORD(100.04,+Y,0)),U,5)
  1. S DA=+Y
  1. I 'NATIONAL D
  1. . S DIE=DIC,DIDEL=100.04,DR=".01;.02;.03;.04;.05///0" D ^DIE
  1. I NATIONAL D
  1. . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. . S DIR(0)="YA"
  1. . S DIR("A")="Do you want to view the contents of the Override Reason? "
  1. . S DIR("A",1)=""
  1. . S DIR("A",2)=" *************************************************"
  1. . S DIR("A",3)=" * You have selected a National Override Reason. *"
  1. . S DIR("A",4)=" * You CANNOT edit this entry. *"
  1. . S DIR("A",5)=" *************************************************"
  1. . S DIR("A",6)=""
  1. . S DIR("B")="NO"
  1. . D ^DIR
  1. . I Y=1 D
  1. .. N DIQ
  1. .. S DIQ(0)="R"
  1. .. W !
  1. .. D EN^DIQ
  1. W ! G EOVR1
  1. Q