source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXC.m@ 619

ORWDXC  ; SLC/KCM - Utilities for Order Checking
        ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,141,221,243**;Dec 17, 1997;Build 242
        ;
ON(VAL) ; returns E if order checking enabled, otherwise D
        S VAL=$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE")
        Q
FILLID(VAL,DLG) ; Return the FillerID (namespace) for a dialog
        N DGRP
        S VAL="",DGRP=$P($G(^ORD(101.41,DLG,0)),U,5) Q:'DGRP
        S DLG=$$DEFDLG^ORWDXQ(DGRP)
        S VAL=$P($G(^ORD(101.41,DLG,0)),U,7),VAL=$$NMSP^ORCD(VAL)
        I VAL="PS" D
        . N X
        . S X=$P($P($G(^ORD(100.98,DGRP,0)),U,3)," ")
        . I $L(X) S VAL="PS"_$S(X="UD":"I",1:X)
        Q
DISPLAY(LST,DFN,FID)    ; Return list of Order Checks for a FillerID (namespace)
        N I,ORX,ORY
        S ORX=1,ORX(1)="|"_FID
        D EN^ORKCHK(.ORY,DFN,.ORX,"DISPLAY")
        S I=0 F  S I=$O(ORY(I)) Q:I'>0  S LST(I)=$P(ORY(I),U,4)
        Q
ACCEPT(LST,DFN,FID,STRT,ORL,OIL,ORIFN)     ; Return list of Order Checks on Accept Order
        ; OIL(n)=OIptr^PS|PSIV|LR^PkgInfo
        N X,Y,USID,ORCHECK,ORI,ORX,ORY
        ; convert relative start date to real start date
        S ORL=ORL_";SC(",X=STRT,STRT=""
        D:X="AM" AM^ORCSAVE2 D:X="NEXT" NEXT^ORCSAVE2
        I $L(X) S %DT="FTX" D ^%DT S:Y'>0 Y="" S STRT=Y
        ; do the SELECT order checks
        S ORI=0 F  S ORI=$O(OIL(ORI)) Q:'ORI  D
        . S USID=$$USID(OIL(ORI))
        . S OIL(ORI,"USID")=USID
        . S ORX=1,ORX(1)=+OIL(ORI)_"|"_FID_"|"_USID
        . D EN^ORKCHK(.ORY,DFN,.ORX,"SELECT")
        . I $D(ORY) D RETURN^ORCHECK ; expects ORY, ORCHECK
        . K ORX,ORY
        ; do the ACCEPT order checks
        S (ORI,ORX)=0 F  S ORI=$O(OIL(ORI)) Q:'ORI  D
        . S ORX=ORX+1
        . S ORX(ORX)=+OIL(ORI)_"|"_FID_"|"_OIL(ORI,"USID")_"|"_STRT
        . I $P(OIL(ORI),U,2)="LR" S $P(ORX(ORX),"|",6)=$P(OIL(ORI),U,3)
        D EN^ORKCHK(.ORY,DFN,.ORX,"ACCEPT")
        I $D(ORY) D RETURN^ORCHECK   ; expects ORY, ORCHECK
        ; return ORCHECK as 1 dimensional list
        D CHK2LST
        Q
DELAY(LST,DFN,FID,STRT,ORL,OIL) ; Return list of Order Checks on Accept Delayed
        ; OIL(n)=OIptr^PS|PSIV|LR^PkgInfo
        N X,Y,ORCHECK,ORI,ORX,ORY
        ; convert relative start date to real start date
        S ORL=ORL_";SC(",X=STRT,STRT=""
        D:X="AM" AM^ORCSAVE2 D:X="NEXT" NEXT^ORCSAVE2
        I $L(X) S %DT="FTX" D ^%DT S:Y'>0 Y="" S STRT=Y
        ; do the ACCEPT order checks
        S (ORI,ORX)=0 F  S ORI=$O(OIL(ORI)) Q:'ORI  D
        . S ORX=ORX+1
        . S ORX(ORX)=+OIL(ORI)_"|"_FID_"|"_$$USID(OIL(ORI))_"|"_STRT
        . I $P(OIL(ORI),U,2)="LR" S $P(ORX(ORX),"|",6)=$P(OIL(ORI),U,3)
        D EN^ORKCHK(.ORY,DFN,.ORX,"ALL")
        I $D(ORY) D RETURN^ORCHECK   ; expects ORY, ORCHECK
        ; return ORCHECK as 1 dimensional list
        D CHK2LST
        Q
SESSION(LST,ORVP,ORLST)  ; Return list of Order Checks on Release Order
        N ORES,ORCHECK
        S ORVP=+ORVP_";DPT("
        S I=0 F  S I=$O(ORLST(I)) Q:'I  D
        . I +$P(ORLST(I),";",2)'=1 Q  ; order not new
        . I $P(ORLST(I),U,3)="0" Q    ; order not being released
        . S ORES($P(ORLST(I),U))=""
        D SESSION^ORCHECK
        D CHK2LST
        Q
SAVECHK(OK,ORVP,RSN,LST)           ; Save order checks for session
        N ORCHECK,ORIFN S OK=1
        D LST2CHK
        I $L(RSN)>0 S ORCHECK("OK")=RSN
        S ORIFN=0 F  S ORIFN=$O(ORCHECK(ORIFN)) Q:'ORIFN  D OC^ORCSAVE2
        Q
DELORD(OK,ORIFN)             ; Delete order
        N STS,DIK,DA
        S STS=$P(^OR(100,+ORIFN,8,1,0),U,15),OK=0
        I (STS=10)!(STS=11) D  Q  ; makes sure it's an unreleased order
        . S DA=+ORIFN,DIK="^OR(100," Q:'DA
        . D ^DIK
        . S OK=1
        Q
USID(ORITMX)    ; Return universal svc ID for an orderable item
        ; ORITMX = OI^NMSP^PKGINFO
        N RSLT,ORDRUG S RSLT=""
        I $E($P(ORITMX,U,2),1,2)="PS" D
        . I $P(ORITMX,U,2)="PSIV" D
        . . N PSOI,TYPE,VOL S VOL=""
        . . S PSOI=+$P($G(^ORD(101.43,+ORITMX,0)),U,2)
        . . S TYPE=$P($P(ORITMX,U,3),";")
        . . I TYPE="B" S VOL=$P($P(ORITMX,U,3),";",2)
        . . D ENDDIV^PSJORUTL(PSOI,TYPE,VOL,.ORDRUG)
        . . S ORDRUG=+ORDRUG
        . E  S ORDRUG=+$P(ORITMX,U,3)
        . S RSLT=$$ENDCM^PSJORUTL(ORDRUG)
        . S RSLT=$P(RSLT,U,3)_"^^99NDF^"_ORDRUG_U_$$NAME50^ORPEAPI(ORDRUG)_"^99PSD"
        E  S RSLT=$$USID^ORMBLD(+ORITMX)
        I +$P(RSLT,U)=0,+($P(RSLT,U,4)=0) S RSLT="" ; has to be null (why?) 
        Q RSLT
        ;
CHK2LST ; creates list that can be passed to broker from ORCHECK array
        ; expects ORCHECK to be present and populates LST
        N ORIFN,ORID,CDL,I,ILST S ILST=1  ;Start array at 1 always leaving room for RDI msg at top
        S ORIFN="" F  S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN=""  D
        . S CDL=0 F  S CDL=$O(ORCHECK(ORIFN,CDL)) Q:'CDL  D
        . . S I=0 F  S I=$O(ORCHECK(ORIFN,CDL,I)) Q:'I  D
        . . . S ORID=ORIFN I +ORID,(+ORID=ORID) S ORID=ORID_";1"
        . . . I '$P(ORCHECK(ORIFN,CDL,I),U,2) Q  ; CDL="" means don't show
        . . . I $P(ORCHECK(ORIFN,CDL,I),U,1)=99 S LST(1)=ORID_U_ORCHECK(ORIFN,CDL,I) Q  ;Put RDI warning at the top
        . . . S ILST=ILST+1,LST(ILST)=ORID_U_ORCHECK(ORIFN,CDL,I)
        Q
LST2CHK ; create ORCHECK array from list passed by broker
        N ORIFN,CDL,I,ILST S I=0
        S ILST=0 F  S ILST=$O(LST(ILST)) Q:'ILST  D
        . S X=LST(ILST)
        . S ORIFN=$P(X,U),CDL=$P(X,U,3)
        . I +$G(ORIFN)>0,+$G(CDL)>0 D  ;cla 12/16/03
        . . S I=I+1,ORCHECK(+ORIFN,CDL,I)=$P(X,U,2,4)
        Q