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