ORWUL ; SLC/KCM/JLI - Listview Selection ;04-Oct-2012 15:40;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,117,131,132,164,1006,215,245,1010**;Dec 17, 1997;Build 47
;Modified - IHS/MSC/JDS - 5/14/2010 - New IHSCR API and Line FVSUB+6
;Modified - IHS/MSC/JDS - 03/12/12 - exclude home med from screening
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
I $P($G(^ORD(101.41,+$P($G(^ORD(101.44,IEN,10,SUB,0)),"^"),0)),"^",3)'="" Q 1
Q 0
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 identified 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:"@")
.S LST(I)=$$IHSCR(IEN,I) ;IHS/MSC/JDS
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
IHSCR(IEN,I) ;EP - Screen drugs IHS/MSC/JDS
N OI,POI,DRUG,OK
S OI=$G(^ORD(101.44,IEN,20,I,0)) I OI="" Q "@"
I '$G(DFN) Q OI
S POI=$P($G(^ORD(101.43,+OI,0)),U,2)
I POI'[";99PSP" Q OI
I $P($G(^ORD(101.44,IEN,0)),U)["NV RX" Q OI
S OK=OI F DRUG=0:0 S DRUG=+$O(^PSDRUG("ASP",+POI,DRUG)) Q:'DRUG S OK="@" I $$SCREEN^APSPMULT(DRUG,,1) S OK=OI Q
Q OK
ORWUL ; SLC/KCM/JLI - Listview Selection ;04-Oct-2012 15:40;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,117,131,132,164,1006,215,245,1010**;Dec 17, 1997;Build 47
+2 ;Modified - IHS/MSC/JDS - 5/14/2010 - New IHSCR API and Line FVSUB+6
+3 ;Modified - IHS/MSC/JDS - 03/12/12 - exclude home med from screening
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 IF $PIECE($GET(^ORD(101.41,+$PIECE($GET(^ORD(101.44,IEN,10,SUB,0)),"^"),0)),"^",3)'=""
QUIT 1
+3 QUIT 0
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 identified a
+5 ;non-existence record
+6 ;S LST(I)=$S($D(^ORD(101.44,IEN,20,$G(I)))>0:^ORD(101.44,IEN,20,I,0),1:"@")
+7 ;IHS/MSC/JDS
SET LST(I)=$$IHSCR(IEN,I)
End DoDot:1
+8 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
IHSCR(IEN,I) ;EP - Screen drugs IHS/MSC/JDS
+1 NEW OI,POI,DRUG,OK
+2 SET OI=$GET(^ORD(101.44,IEN,20,I,0))
IF OI=""
QUIT "@"
+3 IF '$GET(DFN)
QUIT OI
+4 SET POI=$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
+5 IF POI'[";99PSP"
QUIT OI
+6 IF $PIECE($GET(^ORD(101.44,IEN,0)),U)["NV RX"
QUIT OI
+7 SET OK=OI
FOR DRUG=0:0
SET DRUG=+$ORDER(^PSDRUG("ASP",+POI,DRUG))
IF 'DRUG
QUIT
SET OK="@"
IF $$SCREEN^APSPMULT(DRUG,,1)
SET OK=OI
QUIT
+8 QUIT OK
