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

ORB3C1.m

Go to the documentation of this file. 
  1. ORB3C1 ; slc/CLA - Routine to pre-convert OE/RR 2.5 to OE/RR 3 notifications ;7/3/96  15:16 [ 04/03/97  1:41 PM ]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
  1.  Q
  1. PREORB ;initiate pre-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
  1.  ;called by ORCPRE (OE/RR 3 pre-init)
  1.  N ORBC,ORBERR,ORBNOW
  1.  I $L($T(GET^XPAR))>1,($D(^XTV(8989.51,"B","ORBC CONVERSION"))>0) D
  1.  .S ORBC=$$GET^XPAR("SYS","ORBC CONVERSION",1,"Q")
  1.  I +$G(ORBC)>0 D BMES^XPDUTL("Notifications already PRE-converted.") Q
  1.  D BMES^XPDUTL("PRE-conversion of notifications...")
  1.  S ORBNOW=$$NOW^XLFDT
  1.  S ^XTMP("ORBC",0)=$$FMADD^XLFDT(ORBNOW,30,"","","")_U_ORBNOW
  1.  D PRESTUB,PREPKG,PRECONV,PRECLEAN,PRERU,PRERG,PREPF,PREEX
  1.  I $L($T(EN^XPAR))>1,($D(^XTV(8989.51,"B","ORBC CONVERSION"))>0) D
  1.  .D EN^XPAR("SYS","ORBC CONVERSION",1,"1",.ORBERR) ;1:pre-convert done
  1.  D BMES^XPDUTL("PRE-conversion of notifications completed.")
  1.  Q
  1. POSTORB ;initiate post-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
  1.  D POSTORB^ORB3C2
  1.  Q
  1. PRESTUB ;initiate stubbing of notifications 30-57 and renaming of some existing notifictions
  1.  D BMES^XPDUTL("Stubbing notifications 30-49,51-58.")
  1.  N ORBI,ORBA,ORBIEN,ORBERR
  1.  S ORBA(100.9,"+30,",.01)="CONSULT/REQUEST CANCEL/HOLD",ORBIEN(30)=30
  1.  S ORBA(100.9,"+31,",.01)="NPO DIET MORE THAN 72 HRS",ORBIEN(31)=31
  1.  S ORBA(100.9,"+32,",.01)="SITE-FLAGGED RESULTS",ORBIEN(32)=32
  1.  S ORBA(100.9,"+33,",.01)="ORDERER-FLAGGED RESULTS",ORBIEN(33)=33
  1.  S ORBA(100.9,"+35,",.01)="DISCHARGE",ORBIEN(35)=35
  1.  S ORBA(100.9,"+36,",.01)="TRANSFER FROM PSYCHIATRY",ORBIEN(36)=36
  1.  S ORBA(100.9,"+37,",.01)="ORDER REQUIRES CO-SIGNATURE",ORBIEN(37)=37
  1.  S ORBA(100.9,"+41,",.01)="SITE-FLAGGED ORDER",ORBIEN(41)=41
  1.  S ORBA(100.9,"+42,",.01)="LAB ORDER CANCELED",ORBIEN(42)=42
  1.  S ORBA(100.9,"+43,",.01)="STAT ORDER",ORBIEN(43)=43
  1.  S ORBA(100.9,"+44,",.01)="STAT RESULTS",ORBIEN(44)=44
  1.  S ORBA(100.9,"+45,",.01)="DNR EXPIRING",ORBIEN(45)=45
  1.  S ORBA(100.9,"+46,",.01)="FREE TEXT",ORBIEN(46)=46
  1.  S ORBA(100.9,"+47,",.01)="MEDICATIONS EXPIRING",ORBIEN(47)=47
  1.  S ORBA(100.9,"+48,",.01)="UNVERIFIED MEDICATION ORDER",ORBIEN(48)=48
  1.  S ORBA(100.9,"+51,",.01)="STAT IMAGING REQUEST",ORBIEN(51)=51
  1.  S ORBA(100.9,"+52,",.01)="URGENT IMAGING REQUEST",ORBIEN(52)=52
  1.  S ORBA(100.9,"+53,",.01)="IMAGING RESULTS AMENDED",ORBIEN(53)=53
  1.  S ORBA(100.9,"+54,",.01)="ORDER CHECK",ORBIEN(54)=54
  1.  S ORBA(100.9,"+55,",.01)="FOOD/DRUG INTERACTION",ORBIEN(55)=55
  1.  S ORBA(100.9,"+56,",.01)="ERROR MESSAGE",ORBIEN(56)=56
  1.  S ORBA(100.9,"+57,",.01)="CRITICAL LAB RESULTS (ACTION)",ORBIEN(57)=57
  1.  S ORBA(100.9,"+58,",.01)="ABNORMAL LAB RESULT (INFO)",ORBIEN(58)=58
  1.  D CLEAN^DILF
  1.  D UPDATE^DIE("","ORBA","ORBIEN","ORBERR")
  1.  D BMES^XPDUTL("Notification stubbing completed.")
  1.  D BMES^XPDUTL("Renaming notifications 14,21,22,24,25,26,50.")
  1.  S $P(^ORD(100.9,14,0),U)="ABNORMAL LAB RESULTS (ACTION)"
  1.  S $P(^ORD(100.9,21,0),U)="IMAGING PATIENT EXAMINED"
  1.  S $P(^ORD(100.9,22,0),U)="IMAGING RESULTS"
  1.  S $P(^ORD(100.9,24,0),U)="CRITICAL LAB RESULT (INFO)"
  1.  S $P(^ORD(100.9,25,0),U)="ABNORMAL IMAGING RESULTS"
  1.  S $P(^ORD(100.9,26,0),U)="IMAGING REQUEST CANCEL/HELD"
  1.  S $P(^ORD(100.9,50,0),U)="NEW ORDER"
  1.  ;kill then rebuild "B" x-ref:
  1.  K ^ORD(100.9,"B")
  1.  S DIK="^ORD(100.9,",DIK(1)=".01^B" D ENALL^DIK
  1.  K DIK
  1.  D BMES^XPDUTL("Notification renaming completed.")
  1.  Q
  1. PREPKG ;pre-init to kill bad entries in the package file
  1.  S DA=0,DIK="^DIC(9.4,",DA=$O(^DIC(9.4,"C","ORA",DA)) I $L($G(DA)) D ^DIK
  1.  S DA=0,DIK="^DIC(9.4,",DA=$O(^DIC(9.4,"C","ORB",DA)) I $L($G(DA)) D ^DIK
  1.  K DA,DIK
  1.  Q
  1. PRECONV ;convert OE/RR 2.5 alerts that are deleted in the CPRS conversion into
  1.  ;informational alerts and send them to the appropriate user
  1.  N ORBUSR,ORBDT,ORBNOW,ORBNODE,ORBMSG,ORBN,ORBCNT,ORBAID
  1.  S ORBNOW=$$NOW^XLFDT
  1.  S ORBUSR=0,ORBCNT=0
  1.  D BMES^XPDUTL("Converting existing alerts...")
  1.  F  S ORBUSR=$O(^XTV(8992,ORBUSR)) Q:+$G(ORBUSR)<.5  D
  1.  .S ORBDT=0 F  S ORBDT=$O(^XTV(8992,ORBUSR,"XQA",ORBDT)) Q:ORBDT=""  D
  1.  ..S ORBNODE=^XTV(8992,ORBUSR,"XQA",ORBDT,0)
  1.  ..S ORBAID=$P($P(ORBNODE,U,2),";")
  1.  ..Q:$P(ORBAID,",")'="OR"  ;quit if not an OE/RR alert
  1.  ..S ORBN=$P(ORBAID,",",3)  ;get notification ien
  1.  ..;if notification is an alert to be deleted during conversion:
  1.  ..I (ORBN=3)!(ORBN=6)!(ORBN=12)!(ORBN=14)!(ORBN=24)!(ORBN=50) D
  1.  ...S ORBCNT=ORBCNT+1
  1.  ...S ORBMSG=$P(ORBNODE,U,3)
  1.  ...S XQAMSG="[CONV] "_ORBMSG
  1.  ...S XQAID="OR3CONV"_","_ORBCNT_","_ORBNOW
  1.  ...S XQA(ORBUSR)=""
  1.  ...S XQAFLG="I"
  1.  ...D SETUP^XQALERT
  1.  ...K XQAMSG,XQAID,XQA,XQAFLG
  1.  Q
  1. PRECLEAN ;clean up old alerts and unused entries in Notification file
  1.  ; 3 - Lab Results
  1.  ; 6 - Flagged Orders
  1.  ;10 - Unsigned Progress Notes
  1.  ;12 - Orders Requiring Electronic Signature
  1.  ;13 - Co-signature on Progress Notes
  1.  ;14 - Abnormal Labs
  1.  ;15 - Cytology Results
  1.  ;16 - Anatomical Pathology Results
  1.  ;17 - Autopsy Report
  1.  ;24 - Critical Lab Results
  1.  ;50 - Lab critical/abnormal/new rslt
  1.  ;97 - Test Notification
  1.  ;
  1.  ;clean up old alerts with fup actions unprocessable or unused by CPRS:
  1.  N ORBI,ORX S ORBI=""
  1.  D BMES^XPDUTL("Cleaning up old alerts...")
  1.  F ORBI=3,6,10,12,13,14,15,16,17,24,50,97 D
  1.  .Q:'$D(^ORD(100.9,ORBI))
  1.  .D NOTIPURG^XQALBUTL(ORBI)
  1.  .S ORX="   "_$P(^ORD(100.9,ORBI,0),U)_" cleaned up."
  1.  .D BMES^XPDUTL(ORX)
  1.  ;
  1.  K XPDIDTOT
  1.  ;clean up unused entries in the notification file:
  1.  S ORBI=""
  1.  F ORBI=10,13,15,16,17,97 D
  1.  .Q:'$D(^ORD(100.9,ORBI))
  1.  .S DA=ORBI,DIK="^ORD(100.9," D ^DIK
  1.  .K DA,DIK
  1. KILLC ;kill then rebuild "C" x-ref
  1.  K ^ORD(100.9,"C")
  1.  S DIK="^ORD(100.9,",DIK(1)=".02^C" D ENALL^DIK  ;rebuild the "C" x-ref
  1.  K DA,DIK
  1.  Q
  1. PRERU ;pre-init conversion of OE/RR 2.5 RECIPIENT USERS 
  1.  N ORBN,ORBU,ORI,I
  1.  S ORBN=0,ORI="",I=1
  1.  F  S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1  D
  1.  .I $G(^ORD(100.9,ORBN,200,0))="" Q
  1.  .S ORI=0 F  S ORI=$O(^ORD(100.9,ORBN,200,ORI)) Q:'ORI  D
  1.  ..S ORBU=$G(^ORD(100.9,ORBN,200,ORI,0)) Q:ORBU=""
  1.  ..Q:'$L($G(^VA(200,ORBU,0)))
  1.  ..S ^XTMP("ORBC","USER PROCESSING FLAG",I)=ORBU_U_ORBN
  1.  ..S ^XTMP("ORBC","USER PROCESSING FLAG",0)=I,I=I+1
  1.  Q
  1. PRERG ;pre-init conversion of OE/RR 2.5 RECIPIENT GROUPS
  1.  N ORBN,ORBT,ORI,I
  1.  S ORBN=0,ORI="",I=1
  1.  F  S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1  D
  1.  .I $G(^ORD(100.9,ORBN,2,0))="" Q
  1.  .S ORI=0 F  S ORI=$O(^ORD(100.9,ORBN,2,ORI)) Q:'ORI  D
  1.  ..S ORBT=$G(^ORD(100.9,ORBN,2,ORI,0)) Q:ORBT=""
  1.  ..Q:'$L($G(^OR(100.21,ORBT,0)))
  1.  ..S ^XTMP("ORBC","DEFAULT RECIPIENTS",I)=ORBT_U_ORBN
  1.  ..S ^XTMP("ORBC","DEFAULT RECIPIENTS",0)=I,I=I+1
  1.  Q
  1. PREPF ;pre-init conversion of OE/RR 2.5 PROCESSING FLAG
  1.  N ORBN,ORBF,I
  1.  S ORBN=0,I=1
  1.  F  S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1  D
  1.  .S ORBF=$G(^ORD(100.9,ORBN,3))  Q:ORBF=""
  1.  .S ORBF=$S(ORBF["^":$P(ORBF,U),1:ORBF) Q:ORBF=""
  1.  .S ORBF=$S(ORBF="M":"Mandatory",ORBF="E":"Disabled",ORBF="N":"Disabled",ORBF="D":"Disabled",1:"Disabled")
  1.  .S ^XTMP("ORBC","SITE PROCESSING FLAG",I)=ORBF_U_ORBN
  1.  .S ^XTMP("ORBC","SITE PROCESSING FLAG",0)=I,I=I+1
  1.  Q
  1. PREEX ;pre-init conversion of OE/RR 2.5 EXCLUDE ATTENDING & EXCLUDE PRIMARY
  1.  N ORBN,ORBXA,ORBXP,ORBNTOP,I
  1.  S ORBN=0,I=1
  1.  ;
  1.  ;check Order Param file for value of Notification to Physician field:
  1.  S ORBNTOP=$P($G(^ORD(100.99,1,2)),U,11)
  1.  ;
  1.  F  S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1  D
  1.  .Q:$G(^ORD(100.9,ORBN,0))=""
  1.  .Q:$G(^ORD(100.9,ORBN,3))=""  ;quit if a stubbed notif
  1.  .S ORBXA=$P(^ORD(100.9,ORBN,0),U,9),ORBXP=$P(^ORD(100.9,ORBN,0),U,10)
  1.  .I '$L(ORBNTOP),(+$G(ORBXA)<1),(+$G(ORBXP)<1) Q
  1.  .I ($L(ORBXA))!($L(ORBXP)) D
  1.  ..S ^XTMP("ORBC","PROVIDER RECIPIENTS",I)=ORBXA_U_ORBXP_U_ORBNTOP_U_ORBN
  1.  ..S ^XTMP("ORBC","PROVIDER RECIPIENTS",0)=I,I=I+1
  1.  Q