| [613] | 1 | ORY26 ;SLC/MKB-Postinit for patch OR*3*26
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26**;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ENV ; -- environment check
|
|---|
| 5 | ;
|
|---|
| 6 | I '$L($T(GETSVC^GMRCPR0)) W !!,"GMRC*3*5 V5 or higher must be installed!" S XPDQUIT=1 Q
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | PRE ; -- Kill B xref if first install, to be rebuilt in POST
|
|---|
| 10 | ;
|
|---|
| 11 | D OI,PAIN ;inactivate invalid service orderables, add Pain
|
|---|
| 12 | I '$O(^ORD(101.41,"B","OR GTX REQUEST SERVICE",0)) K ^ORD(101.43,"B")
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | POST ; -- cleanup consult orderables, consult-type qo's
|
|---|
| 16 | ;
|
|---|
| 17 | D XREF,GMRCT
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | XREF ; -- Rebuild B, S.XXX xrefs on Orderable Items file #101.43
|
|---|
| 21 | ;
|
|---|
| 22 | Q:$D(^ORD(101.43,"B")) N IDX,DIK,DA
|
|---|
| 23 | S IDX="S" F S IDX=$O(^ORD(101.43,IDX)) Q:IDX'?1"S."1.U K ^(IDX)
|
|---|
| 24 | S DIK="^ORD(101.43,",DIK(1)=".01^B^S0^SS2" D ENALL^DIK
|
|---|
| 25 | ;D EN^GMRCPOS1
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | GMRCT ; -- new field for GMRCT* quick orders
|
|---|
| 29 | ;
|
|---|
| 30 | N CT,FT,DG,ORDLG,OR0,DA,HDR
|
|---|
| 31 | S FT=$$PTR^ORCD("OR GTX FREE TEXT 1"),CT=$$PTR^ORCD("OR GTX FREE TEXT OI"),DG=$O(^ORD(100.98,"B","CSLT",0)),ORDLG=0
|
|---|
| 32 | F S ORDLG=$O(^ORD(101.41,ORDLG)) Q:ORDLG'>0 S OR0=$G(^(ORDLG,0)) D
|
|---|
| 33 | . Q:$P(OR0,U,5)'=DG Q:$P(OR0,U,4)'="Q" ;must be consult qo
|
|---|
| 34 | . S DA=+$O(^ORD(101.41,ORDLG,6,"D"),-1) ;last one
|
|---|
| 35 | . Q:$P($G(^ORD(101.41,ORDLG,6,DA,0)),U,2)'=FT ;ok
|
|---|
| 36 | . S HDR=^ORD(101.41,ORDLG,6,0) K ^(DA) S DA=DA-1
|
|---|
| 37 | . S $P(^ORD(101.41,ORDLG,6,0),U,3,4)=DA_U_($P(HDR,U,4)-1)
|
|---|
| 38 | S ORDLG=+$O(^ORD(101.41,"B","GMRCOR CONSULT",0))
|
|---|
| 39 | S $P(^ORD(101.41,ORDLG,10,1,2),U,2)="@"_CT ;Format code
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | OI ; -- validate Consult service orderables
|
|---|
| 43 | ;
|
|---|
| 44 | N NM,IFN,OI,REBLD,NOW,USAGE,GMRC
|
|---|
| 45 | S NM="",REBLD=0,NOW=$$NOW^XLFDT
|
|---|
| 46 | F S NM=$O(^ORD(101.43,"S.CSLT",NM)) Q:NM="" S IFN=0 D
|
|---|
| 47 | . F S IFN=$O(^ORD(101.43,"S.CSLT",NM,IFN)) Q:IFN'>0 D
|
|---|
| 48 | . . S OI=$G(^ORD(101.43,IFN,0)),ID=$P(OI,U,2)
|
|---|
| 49 | . . S GMRC=$G(^GMR(123.5,+ID,0)),USAGE=$P(GMRC,U,2)
|
|---|
| 50 | . . I ID'?1.N1";99CON"!'$L(GMRC)!($P(GMRC,U)'=$P(OI,U)) D INACT Q
|
|---|
| 51 | . . I USAGE=9 D:$G(^ORD(101.43,IFN,.1))'>0 INACT Q
|
|---|
| 52 | . . S $P(^ORD(101.43,IFN,"CS"),U)=USAGE I $G(^(.1))>0 K ^(.1) S REBLD=1
|
|---|
| 53 | K:$G(REBLD) ^ORD(101.43,"B") ;force postinit to rebuild
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | INACT ; -- inactivate orderable, set REBLD flag
|
|---|
| 57 | Q:$G(^ORD(101.43,IFN,.1))>0 ;already inactive
|
|---|
| 58 | S ^ORD(101.43,IFN,.1)=NOW,REBLD=1
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | PAIN ; -- add Pain to Orderable Items file
|
|---|
| 62 | Q:$O(^ORD(101.43,"S.V/M","PAIN",0)) N X,Y,DIC,DA,DR,DIE,ID,ORDG
|
|---|
| 63 | S X="Pain",DIC="^ORD(101.43,",DIC(0)="LX",DLAYGO=101.43
|
|---|
| 64 | K DD,DO D FILE^DICN Q:Y'>0 S DA=+Y,DIE=DIC
|
|---|
| 65 | S ORDG=+$O(^ORD(100.98,"B","V/M",0)),ID=DA_";99ORD"
|
|---|
| 66 | S DR="1.1///"_X_";2///^S X=ID;5////"_ORDG D ^DIE
|
|---|
| 67 | Q
|
|---|
