- 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 Jan 18, 2025@03:38:55 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