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

ORWUL.m

Go to the documentation of this file.
  1. ORWUL ; SLC/KCM/JLI - Listview Selection ; JUN 18, 2024@15:40
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,117,131,132,164,215,245,610**;Dec 17, 1997;Build 11
  1. ;
  1. ; Reference to ^XTV(8989.5,"AC" in ICR #2686
  1. ; Reference to ^XTV(8989.51,"B" in ICR #2685
  1. ; Reference to ^XTV(8989.518 in ICR #3408
  1. ;
  1. QV4DG(VAL,DGRP) ; return the quick order list, given a display group name
  1. N NM
  1. S VAL="0^0"
  1. I 'DGRP S DGRP=+$O(^ORD(100.98,"B",DGRP,0))
  1. S NM=$$GET^XPAR("ALL","ORWDQ QUICK VIEW",DGRP,"I")
  1. Q:'$L(NM)
  1. D QV4NM(.VAL,NM)
  1. Q
  1. QV4NM(VAL,QVNAM) ; return the current quick list and item count
  1. ; VAL: ListIEN^ItemCount
  1. N J,CNT ;117
  1. S VAL=+$O(^ORD(101.44,"B",QVNAM,0))
  1. S (J,CNT)=0 F S J=$O(^ORD(101.44,VAL,10,J)) Q:'+J I '$$QODIS(VAL,J) S CNT=CNT+1 ;117
  1. S $P(VAL,U,2)=CNT ;117
  1. Q
  1. QVSUB(LST,IEN,FIRST,LAST) ; return subset of orders in view
  1. N I,J,ID ;117
  1. I $L(FIRST),$L(LAST) D
  1. . F I=+FIRST:1:+LAST D
  1. .. I $D(^ORD(101.44,IEN,10,I,0))>0 D
  1. ... I '$$QODIS(IEN,I) S LST(I)=^ORD(101.44,IEN,10,I,0)
  1. E D
  1. . S (I,J)=0 F S I=$O(^ORD(101.44,IEN,10,I)) Q:'+I I '$$QODIS(IEN,I) S J=J+1,LST(J)=^ORD(101.44,IEN,10,I,0) ;117
  1. Q
  1. QODIS(IEN,SUB) ;Determines if personal quick order is disabled
  1. ;returns 1 if it is else 0. This section added with patch 117
  1. N PKGPOS
  1. I $P($G(^ORD(101.41,+$P($G(^ORD(101.44,IEN,10,SUB,0)),"^"),0)),"^",3)'="" Q 1
  1. S PKGPOS=$$QOPOS(IEN) ; Obtaining package position for Pharmacy. If 0, package is outside of Pharmacy
  1. I PKGPOS,$$ORDITMCHK(IEN,PKGPOS,SUB) Q 1 ; If not marked for current package display, then quit/don't add QO to the list
  1. Q 0
  1. QOPOS(QOIEN) ; Matching given IEN to Quick Order Shortname to determine piece position for file 101.43.
  1. N NME,PIECE
  1. S NME=$P($G(^ORD(101.44,QOIEN,0))," ",3,4) D
  1. .S PIECE=$S(NME="UD RX":1,NME="O RX":2,1:0)
  1. Q PIECE ; IF 0, item is outside of Pharmacy package
  1. ORDITMCHK(IEN,ISMRK,SUB) ; Flag to determine if orderable item is marked for current pharmacy package.
  1. ; Returns 1 if ord. item not marked for pharmacy package. 0 if ord. item marked for current package.
  1. ; IEN - Quick View Display IEN
  1. N OEN,OIF,ISVAL,RET
  1. S RET=0
  1. I $P($G(^ORD(101.44,IEN,10,SUB,0)),U) D
  1. . S OEN=$P($G(^ORD(101.44,IEN,10,SUB,0)),U)
  1. . I $G(^ORD(101.41,OEN,6,1,1))'="" S OIF=^ORD(101.41,OEN,6,1,1) D
  1. .. I $P($G(^ORD(101.43,OIF,"PS")),U,ISMRK) S ISVAL=$P($G(^ORD(101.43,OIF,"PS")),U,ISMRK)
  1. I '$D(ISVAL) S RET=1
  1. Q RET
  1. ORDINFCHK(IEN) ;Infusion/Clinic Infusion Orderable Item Check. Returns 1 if ord. item not marked for pharmacy package.
  1. N I,ORDLG,ORFLD,ORID,ORDGNME,ORVALID,ORRTRN
  1. S (I,ORRTRN)=0
  1. F S I=$O(^ORD(101.41,IEN,6,I)) Q:ORRTRN Q:'I D
  1. . S ORDLG=$P(^ORD(101.41,IEN,6,I,0),U,2)
  1. . S ORDGNME=$P(^ORD(101.41,ORDLG,0),U)
  1. . S ORFLD=$S(ORDGNME="OR GTX ORDERABLE ITEM":3,ORDGNME="OR GTX ADDITIVE":4,1:"")
  1. . I ORFLD="" Q
  1. . I $G(^ORD(101.41,IEN,6,I,1))'="" S ORID=^ORD(101.41,IEN,6,I,1) D
  1. .. I $P($G(^ORD(101.43,ORID,"PS")),U,ORFLD)=0 S ORRTRN=1
  1. Q ORRTRN
  1. QVIDX(VAL,IEN,FROM) ; return index of item beginning with FROM
  1. N I,X
  1. S VAL=0
  1. S X=$O(^ORD(101.44,IEN,10,"C",FROM))
  1. I '$L(X) Q
  1. S I=$O(^ORD(101.44,IEN,10,"C",X,0))
  1. Q:'I
  1. S:'$$QODIS(IEN,I) VAL=+I_U_X
  1. Q
  1. FV4DG(VAL,DGNM) ; return the current full list & item count
  1. S VAL=$O(^ORD(101.44,"B","ORWDSET "_DGNM,0))
  1. I 'VAL D
  1. . N UPDTIME,ATTEMPT
  1. . S UPDTIME=$G(^ORD(101.43,"AH","S."_DGNM)),ATTEMPT=0
  1. . I UPDTIME="" S UPDTIME=$H,^ORD(101.43,"AH","S."_DGNM)=UPDTIME
  1. . D FVBLD
  1. . S VAL=$O(^ORD(101.44,"B","ORWDSET "_DGNM,0))
  1. I ($P(^ORD(101.44,+VAL,0),U,6)'=$G(^ORD(101.43,"AH","S."_DGNM))) D
  1. . ; -- see if a task is already queued to rebuild this
  1. . L +^XTMP("ORWDSET "_DGNM):2 E Q
  1. . N ZTSK S ZTSK=+$G(^XTMP("ORWDSET "_DGNM,"TASK"))
  1. . I ZTSK D ISQED^%ZTLOAD S ZTSK=+ZTSK(0)
  1. . I ZTSK L -^XTMP("ORWDSET "_DGNM) Q
  1. . ; -- create a task to rebuild the list
  1. . D FVBLDQ(DGNM)
  1. . L -^XTMP("ORWDSET "_DGNM)
  1. S $P(VAL,U,2)=$P($G(^ORD(101.44,+VAL,20,0)),U,4)
  1. Q
  1. FVSUB(LST,IEN,FIRST,LAST) ; return subset of orders in view
  1. N I
  1. F I=FIRST:1:LAST D
  1. .;AGP change returned valued to returned data or @ if record does not
  1. .;exist. The @ sign is used by the delphi code to identify a
  1. .;non-existence record
  1. .S LST(I)=$S($D(^ORD(101.44,IEN,20,$G(I)))>0:^ORD(101.44,IEN,20,I,0),1:"@")
  1. Q
  1. FVIDX(VAL,IEN,FROM) ; return index of item beginning with FROM
  1. N I,X
  1. S VAL=0
  1. S X=$O(^ORD(101.44,IEN,20,"C",FROM))
  1. I '$L(X) Q
  1. S I=$O(^ORD(101.44,IEN,20,"C",X,0))
  1. Q:'I
  1. S VAL=+I_U_X
  1. Q
  1. FVBLDQ(DGNM,ATTEMPT) ; queue rebuild of set
  1. N ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTDESC,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSK
  1. N UPDTIME S UPDTIME=$G(^ORD(101.43,"AH","S."_DGNM))
  1. I '$G(UPDTIME) S UPDTIME=$H,^ORD(101.43,"AH","S."_DGNM)=UPDTIME
  1. S ATTEMPT=$G(ATTEMPT)+1
  1. S ZTRTN="FVBLD^ORWUL",ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,2)
  1. S ZTSAVE("ATTEMPT")="",ZTSAVE("UPDTIME")="",ZTSAVE("DGNM")=""
  1. S ZTDESC="Rebuild quick view for "_DGNM
  1. D ^%ZTLOAD
  1. S ^XTMP("ORWDSET "_DGNM,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
  1. S ^XTMP("ORWDSET "_DGNM,"TASK")=ZTSK
  1. Q
  1. FVBLD ; rebuild an ORWSET entry
  1. ; ATTEMPT, UPDTIME, DGNM expected in environment
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I $D(ZTQUEUED),(ATTEMPT<20),(UPDTIME'=$G(^ORD(101.43,"AH","S."_DGNM))) D FVBLDQ(DGNM,ATTEMPT) Q
  1. ; -- create new entry in 101.44 for the set
  1. N FDA,FDAIEN,LVW,ADDL
  1. S FDA(101.44,"+1,",.01)="ORWDNEW "_DGNM
  1. S FDA(101.44,"+1,",6)=UPDTIME
  1. D UPDATE^DIE("","FDA","FDAIEN")
  1. S LVW=+FDAIEN(1) I 'LVW G FVBLDX
  1. ; -- copy all the active items into the list multiple
  1. N ASET,SEQ,NM,OI,INACT,CURTM,NMLST,X,Y
  1. S ASET="S."_DGNM,SEQ=0,CURTM=$$NOW^XLFDT
  1. K ^ORD(101.44,LVW,20)
  1. S ^ORD(101.44,LVW,20,0)="^101.442PA"
  1. S NM="" F S NM=$O(^ORD(101.43,ASET,NM)) Q:NM="" D
  1. . K NMLST
  1. . S OI=0 F S OI=$O(^ORD(101.43,ASET,NM,OI)) Q:'OI D
  1. . . S X=^ORD(101.43,ASET,NM,OI),INACT=$P(X,U,3)
  1. . . Q:$P(X,U,5) I INACT,CURTM>INACT Q
  1. . . I 'X S ADDL=""
  1. . . E S ADDL=" <"_$P(X,U,4)_">"
  1. . . I $P($G(^ORD(101.43,OI,"PS")),U,6) S ADDL=ADDL_" NF"
  1. . . S NMLST($P(X,U,2)_ADDL,OI)=""
  1. . I '$D(NMLST) Q
  1. . S X="" F S X=$O(NMLST(X)) Q:X="" D
  1. . . S Y=0 F S Y=$O(NMLST(X,Y)) Q:'Y D
  1. . . . S SEQ=SEQ+1
  1. . . . S ^ORD(101.44,LVW,20,SEQ,0)=Y_U_X
  1. . . . S ^ORD(101.44,LVW,20,"C",$$UP^XLFSTR(X),SEQ)=""
  1. S ^ORD(101.44,LVW,20,0)="^101.442PA^"_SEQ_U_SEQ
  1. ; -- switch the names of the entries (SET->OLD, NEW->SET)
  1. L +^ORD(101.44,"ORWDSET "_DGNM):60
  1. S IEN=$O(^ORD(101.44,"B","ORWDSET "_DGNM,0))
  1. I IEN K FDA S FDA(101.44,IEN_",",.01)="ORWDOLD "_$H
  1. D FILE^DIE("","FDA")
  1. K FDA S FDA(101.44,LVW_",",.01)="ORWDSET "_DGNM
  1. D FILE^DIE("","FDA")
  1. L -^ORD(101.44,"ORWDSET "_DGNM)
  1. FVBLDX ; -- clean up ^XTMP node
  1. K ^XTMP("ORWDSET "_DGNM)
  1. D FVCLN
  1. Q
  1. FVCLN ; clean up old set-type entries in the 101.44
  1. N LNM,DIK,DA
  1. S LNM="ORWDOLD",DIK="^ORD(101.44,"
  1. F S LNM=$O(^ORD(101.44,"B",LNM)) Q:$E(LNM,1,7)'="ORWDOLD" D
  1. . I ($H-$P(LNM," ",2))<2 Q ; wait until entry is 2 days old
  1. . S DA=0 F S DA=$O(^ORD(101.44,"B",LNM,DA)) Q:'DA D ^DIK
  1. Q
  1. QVSAVE(LVW,X,QLST) ; Save a quick order list
  1. ; X: Name of List
  1. ; QLST: Ptr101.41^DisplayName
  1. N DIC,DA,DLAYGO,Y,LVW,SEQ,I
  1. S DIC="^ORD(101.44,",DIC(0)="L",DLAYGO=101.44,LVW=0
  1. D ^DIC Q:'Y
  1. S LVW=+Y,SEQ=0
  1. I $D(^ORD(101.44,LVW,10)) D ; KILL "C" XREF
  1. . N IDX,QOIEN S IDX=0
  1. . F S IDX=$O(^ORD(101.44,LVW,10,IDX)) Q:'IDX D
  1. . . S QOIEN=$P(^ORD(101.44,LVW,10,IDX,0),U)
  1. . . K ^ORD(101.44,"C",QOIEN,LVW,IDX)
  1. K ^ORD(101.44,LVW,10)
  1. S ^ORD(101.44,LVW,10,0)="^101.441PA"
  1. S I=0 F S I=$O(QLST(I)) Q:'I D
  1. . S SEQ=SEQ+1,^ORD(101.44,LVW,10,SEQ,0)=QLST(I)
  1. . S ^ORD(101.44,LVW,10,"C",$$UP^XLFSTR($P(QLST(I),U,2)),SEQ)=""
  1. . S ^ORD(101.44,"C",+QLST(I),LVW,SEQ)=""
  1. S ^ORD(101.44,LVW,10,0)="^101.441PA^"_SEQ_U_SEQ
  1. Q
  1. MVRX ; move pharmacy quick orders into 101.44
  1. D MVQO("O RX")
  1. D MVQO("UD RX")
  1. Q
  1. MVALL ; move all quick order lists into 101.44
  1. Q:$E($O(^ORD(101.44,"B","ORWDQ")),1,5)="ORWDQ"
  1. N SNM
  1. D BMES^XPDUTL("Moving personal quick orders into 101.44")
  1. F SNM="ANI","CARD","CSLT","CT","DO","IV RX","LAB","MAM","MRI","NM","O RX","PROC","RAD","TF","UD RX","US","VAS","XRAY" D
  1. . D MES^XPDUTL("-- moving: "_SNM)
  1. . D MVQO(SNM)
  1. Q
  1. MVQO(DGNM) ; move quick orders
  1. N ENT,PAR,ORTLST,QLST,DLG,X,X0,I,NOP,DNM
  1. S PAR=$O(^XTV(8989.51,"B","ORWDQ "_DGNM,0))
  1. S ENT="" F S ENT=$O(^XTV(8989.5,"AC",PAR,ENT)) Q:'ENT D
  1. . K ORTLST,QLST D GETLST^XPAR(.ORTLST,ENT,PAR,"I")
  1. . S I=0 F S I=$O(ORTLST(I)) Q:'I D
  1. . . S DLG=+ORTLST(I) Q:'DLG
  1. . . S X0=$G(^ORD(101.41,DLG,0)) Q:'$L(X0)
  1. . . S DNM=$$GET^XPAR(ENT,"ORWDQ DISPLAY NAME",DLG,"I")
  1. . . I '$L(DNM) S DNM=$P(^ORD(101.41,DLG,0),U,2)
  1. . . S QLST(I)=DLG_U_DNM
  1. . S X=$O(^XTV(8989.51,PAR,30,"AG",$P(ENT,";",2),0))
  1. . S X=$P(^XTV(8989.51,PAR,30,X,0),U,2)
  1. . S X=$P(^XTV(8989.518,X,0),U,2)
  1. . S X="ORWDQ "_X_$P(ENT,";")_" "_DGNM
  1. . D QVSAVE(.NOP,X,.QLST)
  1. . D EN^XPAR(ENT,"ORWDQ QUICK VIEW",DGNM,X)
  1. . ; D NDEL^XPAR(ENT,PAR) ; -- add later, after sure about conversion
  1. Q
  1. ZCLEAN ; cleanup ORWDQ entries in Quick View file
  1. N ANAM,ANIEN,DIK,DA
  1. S ANAM="ORWDQ",DIK="^ORD(101.44,"
  1. F S ANAM=$O(^ORD(101.44,"B",ANAM)) Q:$E(ANAM,1,5)'="ORWDQ" D
  1. . W !,"deleting "_ANAM
  1. . S ANIEN=$O(^ORD(101.44,"B",ANAM,0))
  1. . S DA=ANIEN D ^DIK
  1. W !,"rebuilding entries"
  1. D MVALL
  1. Q