ORY164 ;SLC/MKB - Postinit for OR*3*164
;;3.0;ORDER ENTRY/RESULTS REPORTING;**164**;Dec 17, 1997
;
PRE ; -- preinit
N ORY,ORERR D FIELD^DID(101.439,2,,"LABEL","ORY","ORERR")
I '$L($G(ORY("LABEL"))) S ^TMP("OR164",$J)=1 ;first install
Q
;
POST ; -- postinit
N X,Y,DIC,DIE,DR,DA,ORCM
S DIC="^DIC(19,",DIC(0)="",X="ORCM MGMT" D ^DIC I Y S ORCM=+Y D
. S DIC="^DIC(19,"_ORCM_",10,",DIC(0)="",X="ORCM ORDERABLES"
. D ^DIC Q:Y<1
. S DR=".01///^S X=""ORCM ORDERABLES MENU"""
. S DA(1)=ORCM,DA=+Y,DIE=DIC D ^DIE
Q:'$G(^TMP("OR164",$J))
P1 ;convert OI Screens on first install only
N I,ORDLG,ORP,ORDA,ORS,Z,NEWSCR
S I=0 F S I=$O(^ORD(101.41,I)) Q:I<1 I $P($G(^(I,0)),U,4)="P",$P($G(^(1)),U)="P",+$P(^(1),U,2)=101.43 S ORP(I)=""
S ORDLG=0 F S ORDLG=+$O(^ORD(101.41,ORDLG)) Q:ORDLG<1 I $P($G(^(ORDLG,0)),U,4)="D" D
. S I=0 F S I=$O(ORP(I)) Q:I<1 S ORDA=+$O(^ORD(101.41,ORDLG,10,"D",I,0)) I ORDA D
.. S ORS=$G(^ORD(101.41,ORDLG,10,ORDA,4))
.. I '$L(ORS) S ^ORD(101.41,ORDLG,10,ORDA,4)="I $$ACTIVE^ORDD43(Y)" Q
.. S Z=$F(ORS,"'$G(^(.1))!($G(^(.1))>$$NOW^XLFDT)") ;$L=34
.. I Z S NEWSCR=$E(ORS,1,(Z-35))_"$$ACTIVE^ORDD43(Y)"_$E(ORS,Z,999),^ORD(101.41,ORDLG,10,ORDA,4)=NEWSCR Q
.. I ORS?1"I ".E S ^ORD(101.41,ORDLG,10,ORDA,4)="I $$ACTIVE^ORDD43(Y),"_$E(ORS,3,999) Q
K ^TMP("OR164",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY164 1329 printed Apr 09, 2024@21:33:11 Page 2
ORY164 ;SLC/MKB - Postinit for OR*3*164
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**164**;Dec 17, 1997
+2 ;
PRE ; -- preinit
+1 NEW ORY,ORERR
DO FIELD^DID(101.439,2,,"LABEL","ORY","ORERR")
+2 ;first install
IF '$LENGTH($GET(ORY("LABEL")))
SET ^TMP("OR164",$JOB)=1
+3 QUIT
+4 ;
POST ; -- postinit
+1 NEW X,Y,DIC,DIE,DR,DA,ORCM
+2 SET DIC="^DIC(19,"
SET DIC(0)=""
SET X="ORCM MGMT"
DO ^DIC
IF Y
SET ORCM=+Y
Begin DoDot:1
+3 SET DIC="^DIC(19,"_ORCM_",10,"
SET DIC(0)=""
SET X="ORCM ORDERABLES"
+4 DO ^DIC
if Y<1
QUIT
+5 SET DR=".01///^S X=""ORCM ORDERABLES MENU"""
+6 SET DA(1)=ORCM
SET DA=+Y
SET DIE=DIC
DO ^DIE
End DoDot:1
+7 if '$GET(^TMP("OR164",$JOB))
QUIT
P1 ;convert OI Screens on first install only
+1 NEW I,ORDLG,ORP,ORDA,ORS,Z,NEWSCR
+2 SET I=0
FOR
SET I=$ORDER(^ORD(101.41,I))
if I<1
QUIT
IF $PIECE($GET(^(I,0)),U,4)="P"
IF $PIECE($GET(^(1)),U)="P"
IF +$PIECE(^(1),U,2)=101.43
SET ORP(I)=""
+3 SET ORDLG=0
FOR
SET ORDLG=+$ORDER(^ORD(101.41,ORDLG))
if ORDLG<1
QUIT
IF $PIECE($GET(^(ORDLG,0)),U,4)="D"
Begin DoDot:1
+4 SET I=0
FOR
SET I=$ORDER(ORP(I))
if I<1
QUIT
SET ORDA=+$ORDER(^ORD(101.41,ORDLG,10,"D",I,0))
IF ORDA
Begin DoDot:2
+5 SET ORS=$GET(^ORD(101.41,ORDLG,10,ORDA,4))
+6 IF '$LENGTH(ORS)
SET ^ORD(101.41,ORDLG,10,ORDA,4)="I $$ACTIVE^ORDD43(Y)"
QUIT
+7 ;$L=34
SET Z=$FIND(ORS,"'$G(^(.1))!($G(^(.1))>$$NOW^XLFDT)")
+8 IF Z
SET NEWSCR=$EXTRACT(ORS,1,(Z-35))_"$$ACTIVE^ORDD43(Y)"_$EXTRACT(ORS,Z,999)
SET ^ORD(101.41,ORDLG,10,ORDA,4)=NEWSCR
QUIT
+9 IF ORS?1"I ".E
SET ^ORD(101.41,ORDLG,10,ORDA,4)="I $$ACTIVE^ORDD43(Y),"_$EXTRACT(ORS,3,999)
QUIT
End DoDot:2
End DoDot:1
+10 KILL ^TMP("OR164",$JOB)
+11 QUIT
