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

ORQOAUIC.m

Go to the documentation of this file.
  1. 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
  1. ;;ICR# Type Description
  1. ;----- ---- -------------------------------------
  1. ;2053 Sup FILE^DIE
  1. ;10103 Sup $$NOW^XLFDT
  1. ;2051 Sup FIND^DIC
  1. Q
  1. ;AUD(DFN,TYPE) ; ENTRY POINT FOR THE TIU OBJECTS
  1. AUD(DFN,TYPE,ORQONAME) ; ENTRY POINT FOR THE TIU OBJECTS
  1. K DIC
  1. N ORDIEN,ORD0,ORD1,ORD2,ORDATA,ORPROVDZ,DA,DIC,DIE,DLAYGO,DR,X,X0,Y
  1. S ORLOC=$P(TIU("LOC"),U,1)
  1. S ORPID=$E(TIU("PID"),3,6)
  1. Q:+DFN'>0 ""
  1. S ORORN=$G(^TMP("OR QUICK ORDER AUDIT",$J,"DLGID")) ; DEFINE QUICK ORDER IEN
  1. 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)
  1. I $G(ORORN) D VERIFY^ORQOAUIC(.ORORN1,ORORN)
  1. Q:'$G(ORORN1) ""
  1. S ORPROV=^TMP("OR QUICK ORDER AUDIT",$J,"REC") S ORPROV=$P(ORPROV,U,4) ; DEFINE PROVIDER
  1. S ORPROVDZ=$$PROVDUZ(ORPROV) ; GET PROVIDER'S DUZ
  1. S X=$$NOW^XLFDT S DIC="^OR(100.95,",DLAYGO=100.95,DIC(0)="L" D FILE^DICN
  1. S DA=+Y,DR="1///"_DUZ_";2///"_DFN_";2.1///"_ORPID_";3///"_ORORN_";4///"_ORPROVDZ_";5///"_TYPE_";6///"_ORLOC,DIE=DIC
  1. D ^DIE
  1. K ORPID,ORPROV,ORLINE,ORLOC,ORORN,ORORN1 ;
  1. Q "** Pharmacy Confirmation #: "_DA
  1. ; QUICK ORDER NUMBER
  1. DRUG(ORDA) ; FOR 'DRUG' COMPUTED FIELD IN THE QUICK ORDER AUDIT FILE
  1. N ORD0,ORD1,ORD2,ORD0AD,ORDRUGFN,ORPHOI
  1. S ORD0=$P(^OR(100.95,ORDA,0),U,4)
  1. Q:ORD0="" "<NONE>"
  1. S ORD1=$O(^ORD(101.41,ORD0,6,"D",4,0))
  1. I $D(^ORD(101.41,ORD0,6,"D",131)) D
  1. .S ORD0AD=0 F S ORD0AD=$O(^ORD(101.41,ORD0,6,"D",131,ORD0AD)) Q:'ORD0AD D
  1. . . S ORD2=+^ORD(101.41,ORD0,6,ORD0AD,1)
  1. . . S ORPHOI=$P($P(^ORD(101.43,ORD2,0),U,2),";",1)
  1. . . S ORDRUGFN=0,ORDRUGFN=$O(^PS(50.7,"A50",ORPHOI,ORDRUGFN))
  1. . . Q:$P(^PSDRUG(ORDRUGFN,0),"^",2)["AM"
  1. S:'$D(^ORD(101.41,ORD0,6,"D",131)) ORD2=+^ORD(101.41,ORD0,6,ORD1,1)
  1. Q $$OUTPUT^ORQOAUIC(ORD2)
  1. OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple of Order Dialog file, 101.41
  1. N ORDIALOG,ORP,ORZ S ORZ=ORY
  1. S ORP=$P($G(^ORD(101.41,ORD0,6,ORD1,0)),U,2)
  1. 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)
  1. Q ORZ
  1. 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
  1. ; If more than one with access code, just pick first one
  1. ; ORCNT = # of users with this ORNAME
  1. ; ORACCNT = # of user with this ORNAME that have an access code
  1. N ORNAME,ORCNT,ORI,USER,ORACCNT
  1. 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
  1. I ORACCNT>0 Q $O(ORACCNT(0)) ; At least one with access code, return first one with DUZ
  1. Q $O(^VA(200,"B",ORNAME,0)) ; No one with access code. Just return first user with this ORNAMe.
  1. GROUPS ;
  1. N DIE,DIC,DA
  1. 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
  1. D ^DIC
  1. S DIE="100.953",DA=+Y,DR="1"
  1. L +^OR(100.953,DA):0 I $T D ^DIE L -^OR(100.953,DA) Q
  1. W !?5,"Another user is editing this entry." Q
  1. VERIFY(ORORN1,DLGID) ;
  1. N ORORN
  1. S ORORN1=0
  1. S ORORN=DLGID S ORLINE=0 F S ORLINE=$O(^ORD(101.41,ORORN,6,3,2,ORLINE)) Q:'ORLINE D
  1. . S ORDATA=$G(^ORD(101.41,ORORN,6,3,2,ORLINE,0)) Q:ORDATA=""
  1. . I ORDATA["|OR QUICK ORDER AUDIT|" S ORORN1=1
  1. . I ORDATA["|OR QUICK ORDER AUDIT(ALT)|" S ORORN1=1
  1. Q