ORY62 ; SLC/MKB - Postinit for patch OR*3*62 ;7/20/99 12:02
;;3.0;ORDER ENTRY/RESULTS REPORTING;**62**;Dec 17, 1997
;
EN ; -- start here
D SCHED,TASK
Q
;
SCHED ; -- Set default schedule for Outpt Meds dialog
N DLG,PRMT,ITM
S DLG=+$O(^ORD(101.41,"AB","PSO OERR",0)) Q:'DLG
S PRMT=+$O(^ORD(101.41,"AB","OR GTX SCHEDULE",0)) Q:'PRMT
S ITM=+$O(^ORD(101.41,DLG,10,"D",PRMT,0)) Q:'ITM
S ^ORD(101.41,DLG,10,ITM,7)="S:$L($G(ORSCHED)) Y=ORSCHED"
Q
;
TASK ; -- task clean up job
;
N ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK,MSG
S ZTDESC="Clean up CPRS verification data"
S ZTRTN="VER^ORY62",ZTIO="",ZTDTH=$H D ^%ZTLOAD
S MSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started."
D MES^XPDUTL(MSG)
Q
;
VER ; -- Clean up verify data in 8 nodes
;
N ORIDX,ORIFN,ORACT,OR0 S ORIDX="^OR(100,""ACT"")"
F S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""ACT"",".E S ORIFN=+$P(ORIDX,",",6),ORACT=+$P(ORIDX,",",7),OR0=$G(^OR(100,ORIFN,8,ORACT,0)) I $P(OR0,U,8),'$P(OR0,U,9),$P(OR0,U,9)=$P($G(^VA(200,+$P(OR0,U,8),0)),U) D
. S OR0=$P(OR0,U,1,8)_U_$P(OR0,U,10,99) ;remove erroneous 9th piece
. S ^OR(100,ORIFN,8,ORACT,0)=OR0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY62 1140 printed Nov 22, 2024@17:53:05 Page 2
ORY62 ; SLC/MKB - Postinit for patch OR*3*62 ;7/20/99 12:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**62**;Dec 17, 1997
+2 ;
EN ; -- start here
+1 DO SCHED
DO TASK
+2 QUIT
+3 ;
SCHED ; -- Set default schedule for Outpt Meds dialog
+1 NEW DLG,PRMT,ITM
+2 SET DLG=+$ORDER(^ORD(101.41,"AB","PSO OERR",0))
if 'DLG
QUIT
+3 SET PRMT=+$ORDER(^ORD(101.41,"AB","OR GTX SCHEDULE",0))
if 'PRMT
QUIT
+4 SET ITM=+$ORDER(^ORD(101.41,DLG,10,"D",PRMT,0))
if 'ITM
QUIT
+5 SET ^ORD(101.41,DLG,10,ITM,7)="S:$L($G(ORSCHED)) Y=ORSCHED"
+6 QUIT
+7 ;
TASK ; -- task clean up job
+1 ;
+2 NEW ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK,MSG
+3 SET ZTDESC="Clean up CPRS verification data"
+4 SET ZTRTN="VER^ORY62"
SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+5 SET MSG="Task "_$SELECT($GET(ZTSK):"#"_ZTSK,1:"not")_" started."
+6 DO MES^XPDUTL(MSG)
+7 QUIT
+8 ;
VER ; -- Clean up verify data in 8 nodes
+1 ;
+2 NEW ORIDX,ORIFN,ORACT,OR0
SET ORIDX="^OR(100,""ACT"")"
+3 FOR
SET ORIDX=$QUERY(@ORIDX)
if ORIDX'?1"^OR(100,""ACT"",".E
QUIT
SET ORIFN=+$PIECE(ORIDX,",",6)
SET ORACT=+$PIECE(ORIDX,",",7)
SET OR0=$GET(^OR(100,ORIFN,8,ORACT,0))
IF $PIECE(OR0,U,8)
IF '$PIECE(OR0,U,9)
IF $PIECE(OR0,U,9)=$PIECE($GET(^VA(200,+$PIECE(OR0,U,8),0)),U)
Begin DoDot:1
+4 ;remove erroneous 9th piece
SET OR0=$PIECE(OR0,U,1,8)_U_$PIECE(OR0,U,10,99)
+5 SET ^OR(100,ORIFN,8,ORACT,0)=OR0
End DoDot:1
+6 QUIT
