[623] | 1 | ORWDXC ; SLC/KCM - Utilities for Order Checking
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,141,221**;Dec 17, 1997
|
---|
| 3 | ;
|
---|
| 4 | ON(VAL) ; returns E if order checking enabled, otherwise D
|
---|
| 5 | S VAL=$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")
|
---|
| 6 | Q
|
---|
| 7 | FILLID(VAL,DLG) ; Return the FillerID (namespace) for a dialog
|
---|
| 8 | N DGRP
|
---|
| 9 | S VAL="",DGRP=$P($G(^ORD(101.41,DLG,0)),U,5) Q:'DGRP
|
---|
| 10 | S DLG=$$DEFDLG^ORWDXQ(DGRP)
|
---|
| 11 | S VAL=$P($G(^ORD(101.41,DLG,0)),U,7),VAL=$$NMSP^ORCD(VAL)
|
---|
| 12 | I VAL="PS" D
|
---|
| 13 | . N X
|
---|
| 14 | . S X=$P($P($G(^ORD(100.98,DGRP,0)),U,3)," ")
|
---|
| 15 | . I $L(X) S VAL="PS"_$S(X="UD":"I",1:X)
|
---|
| 16 | Q
|
---|
| 17 | DISPLAY(LST,DFN,FID) ; Return list of Order Checks for a FillerID (namespace)
|
---|
| 18 | N I,ORX,ORY
|
---|
| 19 | S ORX=1,ORX(1)="|"_FID
|
---|
| 20 | D EN^ORKCHK(.ORY,DFN,.ORX,"DISPLAY")
|
---|
| 21 | S I=0 F S I=$O(ORY(I)) Q:I'>0 S LST(I)=$P(ORY(I),U,4)
|
---|
| 22 | Q
|
---|
| 23 | ACCEPT(LST,DFN,FID,STRT,ORL,OIL,ORIFN) ; Return list of Order Checks on Accept Order
|
---|
| 24 | ; OIL(n)=OIptr^PS|PSIV|LR^PkgInfo
|
---|
| 25 | N X,Y,USID,ORCHECK,ORI,ORX,ORY
|
---|
| 26 | ; convert relative start date to real start date
|
---|
| 27 | S ORL=ORL_";SC(",X=STRT,STRT=""
|
---|
| 28 | D:X="AM" AM^ORCSAVE2 D:X="NEXT" NEXT^ORCSAVE2
|
---|
| 29 | I $L(X) S %DT="FTX" D ^%DT S:Y'>0 Y="" S STRT=Y
|
---|
| 30 | ; do the SELECT order checks
|
---|
| 31 | S ORI=0 F S ORI=$O(OIL(ORI)) Q:'ORI D
|
---|
| 32 | . S USID=$$USID(OIL(ORI))
|
---|
| 33 | . S OIL(ORI,"USID")=USID
|
---|
| 34 | . S ORX=1,ORX(1)=+OIL(ORI)_"|"_FID_"|"_USID
|
---|
| 35 | . D EN^ORKCHK(.ORY,DFN,.ORX,"SELECT")
|
---|
| 36 | . I $D(ORY) D RETURN^ORCHECK ; expects ORY, ORCHECK
|
---|
| 37 | . K ORX,ORY
|
---|
| 38 | ; do the ACCEPT order checks
|
---|
| 39 | S (ORI,ORX)=0 F S ORI=$O(OIL(ORI)) Q:'ORI D
|
---|
| 40 | . S ORX=ORX+1
|
---|
| 41 | . S ORX(ORX)=+OIL(ORI)_"|"_FID_"|"_OIL(ORI,"USID")_"|"_STRT
|
---|
| 42 | . I $P(OIL(ORI),U,2)="LR" S $P(ORX(ORX),"|",6)=$P(OIL(ORI),U,3)
|
---|
| 43 | D EN^ORKCHK(.ORY,DFN,.ORX,"ACCEPT")
|
---|
| 44 | I $D(ORY) D RETURN^ORCHECK ; expects ORY, ORCHECK
|
---|
| 45 | ; return ORCHECK as 1 dimensional list
|
---|
| 46 | D CHK2LST
|
---|
| 47 | Q
|
---|
| 48 | DELAY(LST,DFN,FID,STRT,ORL,OIL) ; Return list of Order Checks on Accept Delayed
|
---|
| 49 | ; OIL(n)=OIptr^PS|PSIV|LR^PkgInfo
|
---|
| 50 | N X,Y,ORCHECK,ORI,ORX,ORY
|
---|
| 51 | ; convert relative start date to real start date
|
---|
| 52 | S ORL=ORL_";SC(",X=STRT,STRT=""
|
---|
| 53 | D:X="AM" AM^ORCSAVE2 D:X="NEXT" NEXT^ORCSAVE2
|
---|
| 54 | I $L(X) S %DT="FTX" D ^%DT S:Y'>0 Y="" S STRT=Y
|
---|
| 55 | ; do the ACCEPT order checks
|
---|
| 56 | S (ORI,ORX)=0 F S ORI=$O(OIL(ORI)) Q:'ORI D
|
---|
| 57 | . S ORX=ORX+1
|
---|
| 58 | . S ORX(ORX)=+OIL(ORI)_"|"_FID_"|"_$$USID(OIL(ORI))_"|"_STRT
|
---|
| 59 | . I $P(OIL(ORI),U,2)="LR" S $P(ORX(ORX),"|",6)=$P(OIL(ORI),U,3)
|
---|
| 60 | D EN^ORKCHK(.ORY,DFN,.ORX,"ALL")
|
---|
| 61 | I $D(ORY) D RETURN^ORCHECK ; expects ORY, ORCHECK
|
---|
| 62 | ; return ORCHECK as 1 dimensional list
|
---|
| 63 | D CHK2LST
|
---|
| 64 | Q
|
---|
| 65 | SESSION(LST,ORVP,ORLST) ; Return list of Order Checks on Release Order
|
---|
| 66 | N ORES,ORCHECK
|
---|
| 67 | S ORVP=+ORVP_";DPT("
|
---|
| 68 | S I=0 F S I=$O(ORLST(I)) Q:'I D
|
---|
| 69 | . I +$P(ORLST(I),";",2)'=1 Q ; order not new
|
---|
| 70 | . I $P(ORLST(I),U,3)="0" Q ; order not being released
|
---|
| 71 | . S ORES($P(ORLST(I),U))=""
|
---|
| 72 | D SESSION^ORCHECK
|
---|
| 73 | D CHK2LST
|
---|
| 74 | Q
|
---|
| 75 | SAVECHK(OK,ORVP,RSN,LST) ; Save order checks for session
|
---|
| 76 | N ORCHECK,ORIFN S OK=1
|
---|
| 77 | D LST2CHK
|
---|
| 78 | I $L(RSN)>0 S ORCHECK("OK")=RSN
|
---|
| 79 | S ORIFN=0 F S ORIFN=$O(ORCHECK(ORIFN)) Q:'ORIFN D OC^ORCSAVE2
|
---|
| 80 | Q
|
---|
| 81 | DELORD(OK,ORIFN) ; Delete order
|
---|
| 82 | N STS,DIK,DA
|
---|
| 83 | S STS=$P(^OR(100,+ORIFN,8,1,0),U,15),OK=0
|
---|
| 84 | I (STS=10)!(STS=11) D Q ; makes sure it's an unreleased order
|
---|
| 85 | . S DA=+ORIFN,DIK="^OR(100," Q:'DA
|
---|
| 86 | . D ^DIK
|
---|
| 87 | . S OK=1
|
---|
| 88 | Q
|
---|
| 89 | USID(ORITMX) ; Return universal svc ID for an orderable item
|
---|
| 90 | ; ORITMX = OI^NMSP^PKGINFO
|
---|
| 91 | N RSLT,ORDRUG S RSLT=""
|
---|
| 92 | I $E($P(ORITMX,U,2),1,2)="PS" D
|
---|
| 93 | . I $P(ORITMX,U,2)="PSIV" D
|
---|
| 94 | . . N PSOI,TYPE,VOL S VOL=""
|
---|
| 95 | . . S PSOI=+$P($G(^ORD(101.43,+ORITMX,0)),U,2)
|
---|
| 96 | . . S TYPE=$P($P(ORITMX,U,3),";")
|
---|
| 97 | . . I TYPE="B" S VOL=$P($P(ORITMX,U,3),";",2)
|
---|
| 98 | . . D ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORDRUG)
|
---|
| 99 | . . S ORDRUG=+ORDRUG
|
---|
| 100 | . E S ORDRUG=+$P(ORITMX,U,3)
|
---|
| 101 | . S RSLT=$$ENDCM^PSJORUTL(ORDRUG)
|
---|
| 102 | . S RSLT=$P(RSLT,U,3)_"^^99NDF^"_ORDRUG_U_$P($G(^PSDRUG(ORDRUG,0)),U)_"^99PSD"
|
---|
| 103 | E S RSLT=$$USID^ORMBLD(+ORITMX)
|
---|
| 104 | I +$P(RSLT,U)=0,+($P(RSLT,U,4)=0) S RSLT="" ; has to be null (why?)
|
---|
| 105 | Q RSLT
|
---|
| 106 | ;
|
---|
| 107 | CHK2LST ; creates list that can be passed to broker from ORCHECK array
|
---|
| 108 | ; expects ORCHECK to be present and populates LST
|
---|
| 109 | N ORIFN,ORID,CDL,I,ILST S ILST=0
|
---|
| 110 | S ORIFN="" F S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN="" D
|
---|
| 111 | . S CDL=0 F S CDL=$O(ORCHECK(ORIFN,CDL)) Q:'CDL D
|
---|
| 112 | . . S I=0 F S I=$O(ORCHECK(ORIFN,CDL,I)) Q:'I D
|
---|
| 113 | . . . S ORID=ORIFN I +ORID,(+ORID=ORID) S ORID=ORID_";1"
|
---|
| 114 | . . . I '$P(ORCHECK(ORIFN,CDL,I),U,2) Q ; CDL="" means don't show
|
---|
| 115 | . . . S ILST=ILST+1,LST(ILST)=ORID_U_ORCHECK(ORIFN,CDL,I)
|
---|
| 116 | Q
|
---|
| 117 | LST2CHK ; create ORCHECK array from list passed by broker
|
---|
| 118 | N ORIFN,CDL,I,ILST S I=0
|
---|
| 119 | S ILST=0 F S ILST=$O(LST(ILST)) Q:'ILST D
|
---|
| 120 | . S X=LST(ILST)
|
---|
| 121 | . S ORIFN=$P(X,U),CDL=$P(X,U,3)
|
---|
| 122 | . I +$G(ORIFN)>0,+$G(CDL)>0 D ;cla 12/16/03
|
---|
| 123 | . . S I=I+1,ORCHECK(+ORIFN,CDL,I)=$P(X,U,2,4)
|
---|
| 124 | Q
|
---|