ORY138 ;SLC/DAN ;3/14/02 15:31
;;3.0;ORDER ENTRY/RESULTS REPORTING;**138**;Dec 17, 1997
;DBIA 2058 allows read of B xref in DIC(9.4
;DBIA 2197 allows reading of install file
;
;Set missing AE xref, fix incorrect package pointer, and fix incorrect display group (TO field).
;
N ORMSG,ZTSK
S ORMSG(1)=""
S ORMSG(2)="This patch contains a post-init. This post-init will"
S ORMSG(3)="run in the background and will fix any known database errors."
S ORMSG(4)="It will then send a mail message to the iniator indicating what was changed."
S ORMSG(5)=""
D MES^XPDUTL(.ORMSG)
S ZTRTN="DQ^ORY138",ZTDESC="Patch OR*3*138 database clean up",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H
D ^%ZTLOAD
I $G(ZTSK) D MES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")
Q
;
DQ ;Enter here for queued task
N ERR
K ^TMP("ORFIX",$J)
D FIXES,FIXPPDG,MAIL
K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)
Q
;
FIXES ;This section will add missing AE Xrefs from active orders
N CNT,PAT,DATE,IEN,PTNAME,STOPDT,DA,CURDT,LASTRUN
S CNT=0
S PAT=""
S LASTRUN=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I") ;last date/time ORMTIME ran
S CURDT=$S(LASTRUN'="":LASTRUN,1:$$NOW^XLFDT) ;Set CURDT to last run date/time or current date/time as appropriate
F S PAT=$O(^OR(100,"AC",PAT)) Q:PAT="" D
.S DATE=0 F S DATE=$O(^OR(100,"AC",PAT,DATE)) Q:'+DATE D
..S IEN=0 F S IEN=$O(^OR(100,"AC",PAT,DATE,IEN)) Q:'+IEN D
...Q:$$NMSP^ORCD($P($G(^OR(100,IEN,0)),U,14))'="PS" ;quit if not pharmacy
...I $O(^OR(100,IEN,8,1)) D CHKACT ;If more than one action check to make sure current action is correct
...Q:$O(^OR(100,IEN,2,0)) ;No AE for parent orders
...S PTNAME=$$PTNM(PAT) Q:PTNAME=-1 ;get patient name quit if referral or couldn't determine name
...S STOPDT=+$P($G(^OR(100,IEN,0)),U,9) Q:'+STOPDT!(STOPDT'>CURDT)
...Q:$D(^OR(100,"AE",STOPDT,IEN)) ;already has an AE xref
...S DA=IEN
...D ES^ORDD100A ;Sets AE xref if appropriate
...I $D(^OR(100,"AE",STOPDT,IEN)) S ^TMP("ORFIX",$J,PTNAME,IEN,"ES")="",CNT=CNT+1
S ^TMP("ORFIX",$J,0)=CNT
Q
;
FIXPPDG ;This section will fix incorrect package pointer and display group problems.
N DATE,IEN,CNT,IPKG,OPKG,IDG,ODG,BADPKG,BADDG,OR0,PTNAME,PCLASS,PKG,TYPE,DG,DIK,DA,EDG,ADMITTED,ENTERED,DIC,DR,ORARRAY
S DATE=$$INSTDT("OR*3.0*94")
S DATE=$S(DATE:$$FMADD^XLFDT(DATE,-1,23,59),1:3000815.24) ;If install date not found revert back to 1st possible install date
S IEN=$$GETIEN(DATE)-1 ;Get first order number for date, subtract one so the first order is reviewed
I IEN=-1 S ERR="No orders in date range" Q ;No orders to review
S CNT=0
S IPKG=$O(^DIC(9.4,"B","INPATIENT MEDICATIONS",0)) ;Inpatient meds package IEN
S OPKG=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) ;Outpatient meds package IEN
S IDG=$O(^ORD(100.98,"B","UD RX",0)) ;Inpatient meds display group IEN
S ODG=$O(^ORD(100.98,"B","O RX",0)) ;Outpatient meds display group IEN
S BADPKG=$O(^DIC(9.4,"B","PHARMACY DATA MANAGEMENT",0)) ;Bad package IEN
S BADDG=$O(^ORD(100.98,"B","PHARMACY",0)) ;Bad display group IEN
I IPKG=""!(OPKG="")!(IDG="")!(ODG="")!(BADPKG="")!(BADDG="") S ERR="Package or display group file entries are missing from the local system." Q ;missing values
F S IEN=$O(^OR(100,IEN)) Q:'+IEN D
.S OR0=$G(^OR(100,IEN,0)) Q:OR0="" ;Missing 0 node
.S PKG=$P(OR0,U,14) ;Current package
.I $$NMSP^ORCD(PKG)'="PS" Q ;Originating package should be a pharmacy type
.S DG=$P(OR0,U,11) ;Current display group (TO field)
.I PKG=BADPKG!(DG=BADDG) D S CNT=CNT+1
..S DIC=9.4,DR=".01",DA=PKG,DIQ="ORARRAY" D EN^DIQ1 S PKGN=ORARRAY(9.4,DA,.01) K DIC,DR,DA,DIQ,ORARRAY
..S DIC=100.98,DR=".01",DA=DG,DIQ="ORARRAY" D EN^DIQ1 S DGN=ORARRAY(100.98,DA,.01) K DIC,DR,DA,DIQ,ORARRAY
..S PTNAME=$$PTNM($P(OR0,U,2))
..I PTNAME=-1 Q ;either patient is referral or is missing
..S PCLASS=$P(OR0,U,12)
..S TYPE=$S($$VALUE^ORX8(IEN,"REFILLS")'="":"OUT",1:"IN") ;Sets type of order to outpatient if there are refills, else inpatient
..I TYPE="OUT" D
...I PCLASS'="O" S ^TMP("ORFIX",$J,PTNAME,IEN,"PC")="INPATIENT to OUTPATIENT" S $P(^OR(100,IEN,0),U,12)="O"
...I PKG'=OPKG S ^TMP("ORFIX",$J,PTNAME,IEN,"PKG")="from "_PKGN_" to OUTPATIENT PHARMACY" S $P(^OR(100,IEN,0),U,14)=OPKG
...I DG'=ODG S ^TMP("ORFIX",$J,PTNAME,IEN,"DG")="from "_DGN_" to O RX" D XREF(IEN,DG,ODG) ;Re-index display group field
..;
..I TYPE="IN" D
...S ENTERED=$P(OR0,U,7) ;Date order entered
...S ADMITTED=$$ADM(IEN,ENTERED)
...I ADMITTED=-1 Q ;unable to detemine patient status
...I PCLASS'="I" S ^TMP("ORFIX",$J,PTNAME,IEN,"PC")="OUTPATIENT to INPATIENT" S $P(^OR(100,IEN,0),U,12)="I"
...I PKG'=IPKG S ^TMP("ORFIX",$J,PTNAME,IEN,"PKG")="from "_PKGN_" to INPATIENT MEDICATIONS" S $P(^OR(100,IEN,0),U,14)=IPKG
...S EDG=$S(ADMITTED:IDG,1:ODG) ;Expected display group
...I DG'=EDG S ^TMP("ORFIX",$J,PTNAME,IEN,"DG")="from "_DGN_" to "_$S(ADMITTED:"UD RX",1:"O RX") D XREF(IEN,DG,EDG) ;Re-index display group
S $P(^TMP("ORFIX",$J,0),U,2)=CNT
Q
;
GETIEN(STDT) ;Find first IEN associated with given start date
N DONE,IEN
S (DONE,IEN)=0
F S STDT=$O(^OR(100,"AF",STDT)) Q:'+STDT!(DONE) D
.S IEN=0 F S IEN=$O(^OR(100,"AF",STDT,IEN)) Q:'+IEN I $O(^(IEN,0))=1 S DONE=1 Q ;Find first ORDER that is a new order
Q IEN
;
MAIL ;Send results of cleanup in a mail message to initiator
N I,XMSUB,XMTEXT,XMDUZ,XMY
S XMSUB="Patch OR*3*138 Clean up completed"
S XMDUZ="Patch OR*3*138 Post-Init"
S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S XMTEXT="^TMP(""ORTXT"",$J,"
K ^TMP("ORTXT",$J)
S I=1
S ^TMP("ORTXT",$J,I)="The database clean-up for patch OR*3*138 has completed.",I=I+1
S ^TMP("ORTXT",$J,I)="Below is a listing of what was changed and any possible error messages.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
S ^TMP("ORTXT",$J,I)=+$P($G(^TMP("ORFIX",$J,0)),U)_" orders had AE cross references added.",I=I+1
S ^TMP("ORTXT",$J,I)=+$P($G(^TMP("ORFIX",$J,0)),U,2)_" orders had their package, display group, or patient class changed.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
I $D(ERR) D
.S ^TMP("ORTXT",$J,I)="An error occurred that stopped the package and display group check.",I=I+1
.S ^TMP("ORTXT",$J,I)="Please log a NOIS and indicate that you received the following error:",I=I+1
.S ^TMP("ORTXT",$J,I)=ERR,I=I+1
.S ^TMP("ORTXT",$J,I)="",I=I+1
.S ^TMP("ORTXT",$J,I)="If any AE cross references were added you will still see the results below.",I=I+1
I '$D(ERR) I $G(^TMP("ORFIX",$J,0))="0^0" S ^TMP("ORTXT",$J,I)="No changes were made to your database.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
S PAT=0 F S PAT=$O(^TMP("ORFIX",$J,PAT)) Q:PAT="" D
.S ^TMP("ORTXT",$J,I)=PAT,I=I+1
.S ORD=0 F S ORD=$O(^TMP("ORFIX",$J,PAT,ORD)) Q:ORD="" D
..S ^TMP("ORTXT",$J,I)=" ORDER #: "_ORD,I=I+1
..F J="ES","DG","PKG","PC" I $D(^TMP("ORFIX",$J,PAT,ORD,J)) D
...S ^TMP("ORTXT",$J,I)=" "_$S(J="ES":"Added AE cross reference ",J="PKG":"Changed package ",J="DG":"Changed display group ",1:"Changed patient class from ")
...S ^TMP("ORTXT",$J,I)=$G(^TMP("ORTXT",$J,I))_$G(^TMP("ORFIX",$J,PAT,ORD,J))
...S I=I+1
.S ^TMP("ORTXT",$J,I)="",I=I+1
D ^XMD ;send results
Q
;
INSTDT(PATCH) ;Returns installation date patch first installed at site
N IEN
S IEN=$O(^XPD(9.7,"B",PATCH,0)) Q:'+IEN 0 ;Get IEN of first installation
Q $P($P($G(^XPD(9.7,IEN,1)),U),".") ;Get date of first install
;
ADM(IEN,ENTERED) ;Determine if patient was inpatient when order was entered
;returns 1 if inpat, 0 if not inpat, -1 if no DFN or object of order is from referral patient file
N DFN,VAIN,VAINDT
S DFN=$P($G(^OR(100,IEN,0)),U,2) ;get object of order
I +DFN=0!(DFN'["DPT") Q -1 ;No DFN found or not from patient file
S DFN=+DFN
S VAINDT=ENTERED
D INP^VADPT
Q $S($G(VAIN(1)):1,1:0) ;If VAIN(1) has a value then patient was an inpatient
;
PTNM(IEN) ;Return pt name or -1 if unable to determine
N DFN,VADM
I +IEN=0!(IEN'["DPT") Q -1
S DFN=+IEN
D ^VADPT
I $G(VADM(1))="" Q -1
Q $G(VADM(1))
;
XREF(IEN,DG,NDG) ;Update xrefs for TO field
N DA,DIE,DR
K ^OR(100,"AW",$P(OR0,U,2),DG,$S($P(OR0,U,8):$P(OR0,U,8),1:9999999),IEN)
S DIE=100,DA=IEN,DR="23///"_NDG D ^DIE
Q
;
CHKACT ;Compares current action field with actual current action and updates if necessary
N CURACT,I,ACT
S CURACT=$P(^OR(100,IEN,3),U,7) Q:'CURACT
S I="?" F S I=$O(^OR(100,IEN,8,I),-1) Q:'+I I $P(^(I,0),U,15)="" S ACT=I Q
I CURACT'=ACT S $P(^OR(100,IEN,3),U,7)=ACT D SETALL^ORDD100(IEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY138 8529 printed Dec 13, 2024@02:38:29 Page 2
ORY138 ;SLC/DAN ;3/14/02 15:31
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**138**;Dec 17, 1997
+2 ;DBIA 2058 allows read of B xref in DIC(9.4
+3 ;DBIA 2197 allows reading of install file
+4 ;
+5 ;Set missing AE xref, fix incorrect package pointer, and fix incorrect display group (TO field).
+6 ;
+7 NEW ORMSG,ZTSK
+8 SET ORMSG(1)=""
+9 SET ORMSG(2)="This patch contains a post-init. This post-init will"
+10 SET ORMSG(3)="run in the background and will fix any known database errors."
+11 SET ORMSG(4)="It will then send a mail message to the iniator indicating what was changed."
+12 SET ORMSG(5)=""
+13 DO MES^XPDUTL(.ORMSG)
+14 SET ZTRTN="DQ^ORY138"
SET ZTDESC="Patch OR*3*138 database clean up"
SET ZTIO=""
SET ZTSAVE("DUZ")=""
SET ZTDTH=$HOROLOG
+15 DO ^%ZTLOAD
+16 IF $GET(ZTSK)
DO MES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")
+17 QUIT
+18 ;
DQ ;Enter here for queued task
+1 NEW ERR
+2 KILL ^TMP("ORFIX",$JOB)
+3 DO FIXES
DO FIXPPDG
DO MAIL
+4 KILL ^TMP("ORFIX",$JOB),^TMP("ORTXT",$JOB)
+5 QUIT
+6 ;
FIXES ;This section will add missing AE Xrefs from active orders
+1 NEW CNT,PAT,DATE,IEN,PTNAME,STOPDT,DA,CURDT,LASTRUN
+2 SET CNT=0
+3 SET PAT=""
+4 ;last date/time ORMTIME ran
SET LASTRUN=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I")
+5 ;Set CURDT to last run date/time or current date/time as appropriate
SET CURDT=$SELECT(LASTRUN'="":LASTRUN,1:$$NOW^XLFDT)
+6 FOR
SET PAT=$ORDER(^OR(100,"AC",PAT))
if PAT=""
QUIT
Begin DoDot:1
+7 SET DATE=0
FOR
SET DATE=$ORDER(^OR(100,"AC",PAT,DATE))
if '+DATE
QUIT
Begin DoDot:2
+8 SET IEN=0
FOR
SET IEN=$ORDER(^OR(100,"AC",PAT,DATE,IEN))
if '+IEN
QUIT
Begin DoDot:3
+9 ;quit if not pharmacy
if $$NMSP^ORCD($PIECE($GET(^OR(100,IEN,0)),U,14))'="PS"
QUIT
+10 ;If more than one action check to make sure current action is correct
IF $ORDER(^OR(100,IEN,8,1))
DO CHKACT
+11 ;No AE for parent orders
if $ORDER(^OR(100,IEN,2,0))
QUIT
+12 ;get patient name quit if referral or couldn't determine name
SET PTNAME=$$PTNM(PAT)
if PTNAME=-1
QUIT
+13 SET STOPDT=+$PIECE($GET(^OR(100,IEN,0)),U,9)
if '+STOPDT!(STOPDT'>CURDT)
QUIT
+14 ;already has an AE xref
if $DATA(^OR(100,"AE",STOPDT,IEN))
QUIT
+15 SET DA=IEN
+16 ;Sets AE xref if appropriate
DO ES^ORDD100A
+17 IF $DATA(^OR(100,"AE",STOPDT,IEN))
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"ES")=""
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET ^TMP("ORFIX",$JOB,0)=CNT
+19 QUIT
+20 ;
FIXPPDG ;This section will fix incorrect package pointer and display group problems.
+1 NEW DATE,IEN,CNT,IPKG,OPKG,IDG,ODG,BADPKG,BADDG,OR0,PTNAME,PCLASS,PKG,TYPE,DG,DIK,DA,EDG,ADMITTED,ENTERED,DIC,DR,ORARRAY
+2 SET DATE=$$INSTDT("OR*3.0*94")
+3 ;If install date not found revert back to 1st possible install date
SET DATE=$SELECT(DATE:$$FMADD^XLFDT(DATE,-1,23,59),1:3000815.24)
+4 ;Get first order number for date, subtract one so the first order is reviewed
SET IEN=$$GETIEN(DATE)-1
+5 ;No orders to review
IF IEN=-1
SET ERR="No orders in date range"
QUIT
+6 SET CNT=0
+7 ;Inpatient meds package IEN
SET IPKG=$ORDER(^DIC(9.4,"B","INPATIENT MEDICATIONS",0))
+8 ;Outpatient meds package IEN
SET OPKG=$ORDER(^DIC(9.4,"B","OUTPATIENT PHARMACY",0))
+9 ;Inpatient meds display group IEN
SET IDG=$ORDER(^ORD(100.98,"B","UD RX",0))
+10 ;Outpatient meds display group IEN
SET ODG=$ORDER(^ORD(100.98,"B","O RX",0))
+11 ;Bad package IEN
SET BADPKG=$ORDER(^DIC(9.4,"B","PHARMACY DATA MANAGEMENT",0))
+12 ;Bad display group IEN
SET BADDG=$ORDER(^ORD(100.98,"B","PHARMACY",0))
+13 ;missing values
IF IPKG=""!(OPKG="")!(IDG="")!(ODG="")!(BADPKG="")!(BADDG="")
SET ERR="Package or display group file entries are missing from the local system."
QUIT
+14 FOR
SET IEN=$ORDER(^OR(100,IEN))
if '+IEN
QUIT
Begin DoDot:1
+15 ;Missing 0 node
SET OR0=$GET(^OR(100,IEN,0))
if OR0=""
QUIT
+16 ;Current package
SET PKG=$PIECE(OR0,U,14)
+17 ;Originating package should be a pharmacy type
IF $$NMSP^ORCD(PKG)'="PS"
QUIT
+18 ;Current display group (TO field)
SET DG=$PIECE(OR0,U,11)
+19 IF PKG=BADPKG!(DG=BADDG)
Begin DoDot:2
+20 SET DIC=9.4
SET DR=".01"
SET DA=PKG
SET DIQ="ORARRAY"
DO EN^DIQ1
SET PKGN=ORARRAY(9.4,DA,.01)
KILL DIC,DR,DA,DIQ,ORARRAY
+21 SET DIC=100.98
SET DR=".01"
SET DA=DG
SET DIQ="ORARRAY"
DO EN^DIQ1
SET DGN=ORARRAY(100.98,DA,.01)
KILL DIC,DR,DA,DIQ,ORARRAY
+22 SET PTNAME=$$PTNM($PIECE(OR0,U,2))
+23 ;either patient is referral or is missing
IF PTNAME=-1
QUIT
+24 SET PCLASS=$PIECE(OR0,U,12)
+25 ;Sets type of order to outpatient if there are refills, else inpatient
SET TYPE=$SELECT($$VALUE^ORX8(IEN,"REFILLS")'="":"OUT",1:"IN")
+26 IF TYPE="OUT"
Begin DoDot:3
+27 IF PCLASS'="O"
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"PC")="INPATIENT to OUTPATIENT"
SET $PIECE(^OR(100,IEN,0),U,12)="O"
+28 IF PKG'=OPKG
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"PKG")="from "_PKGN_" to OUTPATIENT PHARMACY"
SET $PIECE(^OR(100,IEN,0),U,14)=OPKG
+29 ;Re-index display group field
IF DG'=ODG
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"DG")="from "_DGN_" to O RX"
DO XREF(IEN,DG,ODG)
End DoDot:3
+30 ;
+31 IF TYPE="IN"
Begin DoDot:3
+32 ;Date order entered
SET ENTERED=$PIECE(OR0,U,7)
+33 SET ADMITTED=$$ADM(IEN,ENTERED)
+34 ;unable to detemine patient status
IF ADMITTED=-1
QUIT
+35 IF PCLASS'="I"
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"PC")="OUTPATIENT to INPATIENT"
SET $PIECE(^OR(100,IEN,0),U,12)="I"
+36 IF PKG'=IPKG
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"PKG")="from "_PKGN_" to INPATIENT MEDICATIONS"
SET $PIECE(^OR(100,IEN,0),U,14)=IPKG
+37 ;Expected display group
SET EDG=$SELECT(ADMITTED:IDG,1:ODG)
+38 ;Re-index display group
IF DG'=EDG
SET ^TMP("ORFIX",$JOB,PTNAME,IEN,"DG")="from "_DGN_" to "_$SELECT(ADMITTED:"UD RX",1:"O RX")
DO XREF(IEN,DG,EDG)
End DoDot:3
End DoDot:2
SET CNT=CNT+1
End DoDot:1
+39 SET $PIECE(^TMP("ORFIX",$JOB,0),U,2)=CNT
+40 QUIT
+41 ;
GETIEN(STDT) ;Find first IEN associated with given start date
+1 NEW DONE,IEN
+2 SET (DONE,IEN)=0
+3 FOR
SET STDT=$ORDER(^OR(100,"AF",STDT))
if '+STDT!(DONE)
QUIT
Begin DoDot:1
+4 ;Find first ORDER that is a new order
SET IEN=0
FOR
SET IEN=$ORDER(^OR(100,"AF",STDT,IEN))
if '+IEN
QUIT
IF $ORDER(^(IEN,0))=1
SET DONE=1
QUIT
End DoDot:1
+5 QUIT IEN
+6 ;
MAIL ;Send results of cleanup in a mail message to initiator
+1 NEW I,XMSUB,XMTEXT,XMDUZ,XMY
+2 SET XMSUB="Patch OR*3*138 Clean up completed"
+3 SET XMDUZ="Patch OR*3*138 Post-Init"
+4 SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+5 SET XMTEXT="^TMP(""ORTXT"",$J,"
+6 KILL ^TMP("ORTXT",$JOB)
+7 SET I=1
+8 SET ^TMP("ORTXT",$JOB,I)="The database clean-up for patch OR*3*138 has completed."
SET I=I+1
+9 SET ^TMP("ORTXT",$JOB,I)="Below is a listing of what was changed and any possible error messages."
SET I=I+1
+10 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+11 SET ^TMP("ORTXT",$JOB,I)=+$PIECE($GET(^TMP("ORFIX",$JOB,0)),U)_" orders had AE cross references added."
SET I=I+1
+12 SET ^TMP("ORTXT",$JOB,I)=+$PIECE($GET(^TMP("ORFIX",$JOB,0)),U,2)_" orders had their package, display group, or patient class changed."
SET I=I+1
+13 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+14 IF $DATA(ERR)
Begin DoDot:1
+15 SET ^TMP("ORTXT",$JOB,I)="An error occurred that stopped the package and display group check."
SET I=I+1
+16 SET ^TMP("ORTXT",$JOB,I)="Please log a NOIS and indicate that you received the following error:"
SET I=I+1
+17 SET ^TMP("ORTXT",$JOB,I)=ERR
SET I=I+1
+18 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+19 SET ^TMP("ORTXT",$JOB,I)="If any AE cross references were added you will still see the results below."
SET I=I+1
End DoDot:1
+20 IF '$DATA(ERR)
IF $GET(^TMP("ORFIX",$JOB,0))="0^0"
SET ^TMP("ORTXT",$JOB,I)="No changes were made to your database."
SET I=I+1
+21 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+22 SET PAT=0
FOR
SET PAT=$ORDER(^TMP("ORFIX",$JOB,PAT))
if PAT=""
QUIT
Begin DoDot:1
+23 SET ^TMP("ORTXT",$JOB,I)=PAT
SET I=I+1
+24 SET ORD=0
FOR
SET ORD=$ORDER(^TMP("ORFIX",$JOB,PAT,ORD))
if ORD=""
QUIT
Begin DoDot:2
+25 SET ^TMP("ORTXT",$JOB,I)=" ORDER #: "_ORD
SET I=I+1
+26 FOR J="ES","DG","PKG","PC"
IF $DATA(^TMP("ORFIX",$JOB,PAT,ORD,J))
Begin DoDot:3
+27 SET ^TMP("ORTXT",$JOB,I)=" "_$SELECT(J="ES":"Added AE cross reference ",J="PKG":"Changed package ",J="DG":"Changed display group ",1:"Changed patient class from ")
+28 SET ^TMP("ORTXT",$JOB,I)=$GET(^TMP("ORTXT",$JOB,I))_$GET(^TMP("ORFIX",$JOB,PAT,ORD,J))
+29 SET I=I+1
End DoDot:3
End DoDot:2
+30 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
End DoDot:1
+31 ;send results
DO ^XMD
+32 QUIT
+33 ;
INSTDT(PATCH) ;Returns installation date patch first installed at site
+1 NEW IEN
+2 ;Get IEN of first installation
SET IEN=$ORDER(^XPD(9.7,"B",PATCH,0))
if '+IEN
QUIT 0
+3 ;Get date of first install
QUIT $PIECE($PIECE($GET(^XPD(9.7,IEN,1)),U),".")
+4 ;
ADM(IEN,ENTERED) ;Determine if patient was inpatient when order was entered
+1 ;returns 1 if inpat, 0 if not inpat, -1 if no DFN or object of order is from referral patient file
+2 NEW DFN,VAIN,VAINDT
+3 ;get object of order
SET DFN=$PIECE($GET(^OR(100,IEN,0)),U,2)
+4 ;No DFN found or not from patient file
IF +DFN=0!(DFN'["DPT")
QUIT -1
+5 SET DFN=+DFN
+6 SET VAINDT=ENTERED
+7 DO INP^VADPT
+8 ;If VAIN(1) has a value then patient was an inpatient
QUIT $SELECT($GET(VAIN(1)):1,1:0)
+9 ;
PTNM(IEN) ;Return pt name or -1 if unable to determine
+1 NEW DFN,VADM
+2 IF +IEN=0!(IEN'["DPT")
QUIT -1
+3 SET DFN=+IEN
+4 DO ^VADPT
+5 IF $GET(VADM(1))=""
QUIT -1
+6 QUIT $GET(VADM(1))
+7 ;
XREF(IEN,DG,NDG) ;Update xrefs for TO field
+1 NEW DA,DIE,DR
+2 KILL ^OR(100,"AW",$PIECE(OR0,U,2),DG,$SELECT($PIECE(OR0,U,8):$PIECE(OR0,U,8),1:9999999),IEN)
+3 SET DIE=100
SET DA=IEN
SET DR="23///"_NDG
DO ^DIE
+4 QUIT
+5 ;
CHKACT ;Compares current action field with actual current action and updates if necessary
+1 NEW CURACT,I,ACT
+2 SET CURACT=$PIECE(^OR(100,IEN,3),U,7)
if 'CURACT
QUIT
+3 SET I="?"
FOR
SET I=$ORDER(^OR(100,IEN,8,I),-1)
if '+I
QUIT
IF $PIECE(^(I,0),U,15)=""
SET ACT=I
QUIT
+4 IF CURACT'=ACT
SET $PIECE(^OR(100,IEN,3),U,7)=ACT
DO SETALL^ORDD100(IEN)
+5 QUIT
