ORQOAUIC ;EPIP/RTW - QUICK ORDER DATA RETRIEVAL ; 12/28/17 2:21pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**441**;Dec 17, 1997;Build 52
;;ICR# Type Description
;----- ---- -------------------------------------
;2053 Sup FILE^DIE
;10103 Sup $$NOW^XLFDT
;2051 Sup FIND^DIC
Q
;AUD(DFN,TYPE) ; ENTRY POINT FOR THE TIU OBJECTS
AUD(DFN,TYPE,ORQONAME) ; ENTRY POINT FOR THE TIU OBJECTS
K DIC
N ORDIEN,ORD0,ORD1,ORD2,ORDATA,ORPROVDZ,DA,DIC,DIE,DLAYGO,DR,X,X0,Y
S ORLOC=$P(TIU("LOC"),U,1)
S ORPID=$E(TIU("PID"),3,6)
Q:+DFN'>0 ""
S ORORN=$G(^TMP("OR QUICK ORDER AUDIT",$J,"DLGID")) ; DEFINE QUICK ORDER IEN
I '$G(ORORN),$D(ORQONAME) D FIND^DIC(101.41,,,"X",ORQONAME,,"B",,,"ORDIEN") I $D(ORDIEN("DILIST","2",1)) S ORORN=$P(ORDIEN("DILIST","2",1),U,1)
I $G(ORORN) D VERIFY^ORQOAUIC(.ORORN1,ORORN)
Q:'$G(ORORN1) ""
S ORPROV=^TMP("OR QUICK ORDER AUDIT",$J,"REC") S ORPROV=$P(ORPROV,U,4) ; DEFINE PROVIDER
S ORPROVDZ=$$PROVDUZ(ORPROV) ; GET PROVIDER'S DUZ
S X=$$NOW^XLFDT S DIC="^OR(100.95,",DLAYGO=100.95,DIC(0)="L" D FILE^DICN
S DA=+Y,DR="1///"_DUZ_";2///"_DFN_";2.1///"_ORPID_";3///"_ORORN_";4///"_ORPROVDZ_";5///"_TYPE_";6///"_ORLOC,DIE=DIC
D ^DIE
K ORPID,ORPROV,ORLINE,ORLOC,ORORN,ORORN1 ;
Q "** Pharmacy Confirmation #: "_DA
; QUICK ORDER NUMBER
DRUG(ORDA) ; FOR 'DRUG' COMPUTED FIELD IN THE QUICK ORDER AUDIT FILE
N ORD0,ORD1,ORD2,ORD0AD,ORDRUGFN,ORPHOI
S ORD0=$P(^OR(100.95,ORDA,0),U,4)
Q:ORD0="" "<NONE>"
S ORD1=$O(^ORD(101.41,ORD0,6,"D",4,0))
I $D(^ORD(101.41,ORD0,6,"D",131)) D
.S ORD0AD=0 F S ORD0AD=$O(^ORD(101.41,ORD0,6,"D",131,ORD0AD)) Q:'ORD0AD D
. . S ORD2=+^ORD(101.41,ORD0,6,ORD0AD,1)
. . S ORPHOI=$P($P(^ORD(101.43,ORD2,0),U,2),";",1)
. . S ORDRUGFN=0,ORDRUGFN=$O(^PS(50.7,"A50",ORPHOI,ORDRUGFN))
. . Q:$P(^PSDRUG(ORDRUGFN,0),"^",2)["AM"
S:'$D(^ORD(101.41,ORD0,6,"D",131)) ORD2=+^ORD(101.41,ORD0,6,ORD1,1)
Q $$OUTPUT^ORQOAUIC(ORD2)
OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple of Order Dialog file, 101.41
N ORDIALOG,ORP,ORZ S ORZ=ORY
S ORP=$P($G(^ORD(101.41,ORD0,6,ORD1,0)),U,2)
I ORP S ORDIALOG(ORP,0)=$P($G(^ORD(101.41,ORP,1)),U,1,2),ORDIALOG(ORP,1)=ORY,ORZ=$$EXT^ORCD(ORP,1)
Q ORZ
PROVDUZ(ORUN) ; RETURN DUZ FOR USER ORUN WHERE ORUN IS USER'S NAME
; If more than one user with this ORNAMe, pick one with access code
; If more than one with access code, just pick first one
; ORCNT = # of users with this ORNAME
; ORACCNT = # of user with this ORNAME that have an access code
N ORNAME,ORCNT,ORI,USER,ORACCNT
S ORNAME=$E(ORUN,1,35),(ORCNT,ORI,ORACCNT)=0 F S ORI=$O(^VA(200,"B",ORNAME,ORI)) Q:+ORI'>0 S ORCNT=ORCNT+1 I $P($G(^VA(200,ORI,0)),U,3) S ORACCNT=ORACCNT+1 S ORACCNT(ORI)="" ; COUNT USERS WITH THIS ORNAME
I ORACCNT>0 Q $O(ORACCNT(0)) ; At least one with access code, return first one with DUZ
Q $O(^VA(200,"B",ORNAME,0)) ; No one with access code. Just return first user with this ORNAMe.
GROUPS ;
N DIE,DIC,DA
W !!,"Create or edit a Group of Medical Center Divisions you want to print together on the monthly quick order audit report",! S DIC("A")="Select a Group: ",(DIC,DIE)="^OR(100.953,",DIC(0)="QEALM",DLAYGO=100.953
D ^DIC
S DIE="100.953",DA=+Y,DR="1"
L +^OR(100.953,DA):0 I $T D ^DIE L -^OR(100.953,DA) Q
W !?5,"Another user is editing this entry." Q
VERIFY(ORORN1,DLGID) ;
N ORORN
S ORORN1=0
S ORORN=DLGID S ORLINE=0 F S ORLINE=$O(^ORD(101.41,ORORN,6,3,2,ORLINE)) Q:'ORLINE D
. S ORDATA=$G(^ORD(101.41,ORORN,6,3,2,ORLINE,0)) Q:ORDATA=""
. I ORDATA["|OR QUICK ORDER AUDIT|" S ORORN1=1
. I ORDATA["|OR QUICK ORDER AUDIT(ALT)|" S ORORN1=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQOAUIC 3636 printed Dec 13, 2024@02:33:15 Page 2
ORQOAUIC ;EPIP/RTW - QUICK ORDER DATA RETRIEVAL ; 12/28/17 2:21pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**441**;Dec 17, 1997;Build 52
+2 ;;ICR# Type Description
+3 ;----- ---- -------------------------------------
+4 ;2053 Sup FILE^DIE
+5 ;10103 Sup $$NOW^XLFDT
+6 ;2051 Sup FIND^DIC
+7 QUIT
+8 ;AUD(DFN,TYPE) ; ENTRY POINT FOR THE TIU OBJECTS
AUD(DFN,TYPE,ORQONAME) ; ENTRY POINT FOR THE TIU OBJECTS
+1 KILL DIC
+2 NEW ORDIEN,ORD0,ORD1,ORD2,ORDATA,ORPROVDZ,DA,DIC,DIE,DLAYGO,DR,X,X0,Y
+3 SET ORLOC=$PIECE(TIU("LOC"),U,1)
+4 SET ORPID=$EXTRACT(TIU("PID"),3,6)
+5 if +DFN'>0
QUIT ""
+6 ; DEFINE QUICK ORDER IEN
SET ORORN=$GET(^TMP("OR QUICK ORDER AUDIT",$JOB,"DLGID"))
+7 IF '$GET(ORORN)
IF $DATA(ORQONAME)
DO FIND^DIC(101.41,,,"X",ORQONAME,,"B",,,"ORDIEN")
IF $DATA(ORDIEN("DILIST","2",1))
SET ORORN=$PIECE(ORDIEN("DILIST","2",1),U,1)
+8 IF $GET(ORORN)
DO VERIFY^ORQOAUIC(.ORORN1,ORORN)
+9 if '$GET(ORORN1)
QUIT ""
+10 ; DEFINE PROVIDER
SET ORPROV=^TMP("OR QUICK ORDER AUDIT",$JOB,"REC")
SET ORPROV=$PIECE(ORPROV,U,4)
+11 ; GET PROVIDER'S DUZ
SET ORPROVDZ=$$PROVDUZ(ORPROV)
+12 SET X=$$NOW^XLFDT
SET DIC="^OR(100.95,"
SET DLAYGO=100.95
SET DIC(0)="L"
DO FILE^DICN
+13 SET DA=+Y
SET DR="1///"_DUZ_";2///"_DFN_";2.1///"_ORPID_";3///"_ORORN_";4///"_ORPROVDZ_";5///"_TYPE_";6///"_ORLOC
SET DIE=DIC
+14 DO ^DIE
+15 ;
KILL ORPID,ORPROV,ORLINE,ORLOC,ORORN,ORORN1
+16 QUIT "** Pharmacy Confirmation #: "_DA
+17 ; QUICK ORDER NUMBER
DRUG(ORDA) ; FOR 'DRUG' COMPUTED FIELD IN THE QUICK ORDER AUDIT FILE
+1 NEW ORD0,ORD1,ORD2,ORD0AD,ORDRUGFN,ORPHOI
+2 SET ORD0=$PIECE(^OR(100.95,ORDA,0),U,4)
+3 if ORD0=""
QUIT "<NONE>"
+4 SET ORD1=$ORDER(^ORD(101.41,ORD0,6,"D",4,0))
+5 IF $DATA(^ORD(101.41,ORD0,6,"D",131))
Begin DoDot:1
+6 SET ORD0AD=0
FOR
SET ORD0AD=$ORDER(^ORD(101.41,ORD0,6,"D",131,ORD0AD))
if 'ORD0AD
QUIT
Begin DoDot:2
+7 SET ORD2=+^ORD(101.41,ORD0,6,ORD0AD,1)
+8 SET ORPHOI=$PIECE($PIECE(^ORD(101.43,ORD2,0),U,2),";",1)
+9 SET ORDRUGFN=0
SET ORDRUGFN=$ORDER(^PS(50.7,"A50",ORPHOI,ORDRUGFN))
+10 if $PIECE(^PSDRUG(ORDRUGFN,0),"^",2)["AM"
QUIT
End DoDot:2
End DoDot:1
+11 if '$DATA(^ORD(101.41,ORD0,6,"D",131))
SET ORD2=+^ORD(101.41,ORD0,6,ORD1,1)
+12 QUIT $$OUTPUT^ORQOAUIC(ORD2)
OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple of Order Dialog file, 101.41
+1 NEW ORDIALOG,ORP,ORZ
SET ORZ=ORY
+2 SET ORP=$PIECE($GET(^ORD(101.41,ORD0,6,ORD1,0)),U,2)
+3 IF ORP
SET ORDIALOG(ORP,0)=$PIECE($GET(^ORD(101.41,ORP,1)),U,1,2)
SET ORDIALOG(ORP,1)=ORY
SET ORZ=$$EXT^ORCD(ORP,1)
+4 QUIT ORZ
PROVDUZ(ORUN) ; RETURN DUZ FOR USER ORUN WHERE ORUN IS USER'S NAME
+1 ; If more than one user with this ORNAMe, pick one with access code
+2 ; If more than one with access code, just pick first one
+3 ; ORCNT = # of users with this ORNAME
+4 ; ORACCNT = # of user with this ORNAME that have an access code
+5 NEW ORNAME,ORCNT,ORI,USER,ORACCNT
+6 ; COUNT USERS WITH THIS ORNAME
SET ORNAME=$EXTRACT(ORUN,1,35)
SET (ORCNT,ORI,ORACCNT)=0
FOR
SET ORI=$ORDER(^VA(200,"B",ORNAME,ORI))
if +ORI'>0
QUIT
SET ORCNT=ORCNT+1
IF $PIECE($GET(^VA(200,ORI,0)),U,3)
SET ORACCNT=ORACCNT+1
SET ORACCNT(ORI)=""
+7 ; At least one with access code, return first one with DUZ
IF ORACCNT>0
QUIT $ORDER(ORACCNT(0))
+8 ; No one with access code. Just return first user with this ORNAMe.
QUIT $ORDER(^VA(200,"B",ORNAME,0))
GROUPS ;
+1 NEW DIE,DIC,DA
+2 WRITE !!,"Create or edit a Group of Medical Center Divisions you want to print together on the monthly quick order audit report",!
SET DIC("A")="Select a Group: "
SET (DIC,DIE)="^OR(100.953,"
SET DIC(0)="QEALM"
SET DLAYGO=100.953
+3 DO ^DIC
+4 SET DIE="100.953"
SET DA=+Y
SET DR="1"
+5 LOCK +^OR(100.953,DA):0
IF $TEST
DO ^DIE
LOCK -^OR(100.953,DA)
QUIT
+6 WRITE !?5,"Another user is editing this entry."
QUIT
VERIFY(ORORN1,DLGID) ;
+1 NEW ORORN
+2 SET ORORN1=0
+3 SET ORORN=DLGID
SET ORLINE=0
FOR
SET ORLINE=$ORDER(^ORD(101.41,ORORN,6,3,2,ORLINE))
if 'ORLINE
QUIT
Begin DoDot:1
+4 SET ORDATA=$GET(^ORD(101.41,ORORN,6,3,2,ORLINE,0))
if ORDATA=""
QUIT
+5 IF ORDATA["|OR QUICK ORDER AUDIT|"
SET ORORN1=1
+6 IF ORDATA["|OR QUICK ORDER AUDIT(ALT)|"
SET ORORN1=1
End DoDot:1
+7 QUIT
