- 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 Feb 18, 2025@23:59:48 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