ORY129.m

ORY129 ;SLC/MKB - Postinit for patch OR*3*129 ;12/11/01  11:04

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**129**;Dec 17, 1997

 ;

POST ; -- postinit

 N IFN,X S IFN=+$P($G(^OR(100,0)),U,3)

 F  S IFN=$O(^OR(100,IFN)) Q:IFN?1"A".E  I IFN[";" S X=$G(^(IFN,5)) S:$L(X) ^OR(100,+IFN,5)=X K ^OR(100,IFN,5)

 D TASK

 Q

 ;

TASK ; -- task cleanup of AC xref

 N ORMSG,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK

 S ORMSG(1)="Please queue the background job to clean up changed orders in the",ORMSG(2)="Active Orders index on file #100."

 D MES^XPDUTL(.ORMSG) K ORMSG

 S ZTDESC="Cleanup AC xref on Orders file #100",ZTIO=""

 S ZTRTN="EN^ORY129" D ^%ZTLOAD

 S ORMSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" queued."

 D MES^XPDUTL(ORMSG) I '$G(ZTSK) D BMES^XPDUTL("Use TASK^ORY129 to run this job later, if needed.")

 Q

 ;

EN ; -- main conversion loop

 N ORIDX,ORPSJ,ORIFN,ORDA,OR0,OR3,OR8

 S ORIDX="^OR(100,""AC"")",ORPSJ=+$O(^DIC(9.4,"C","PSJ",0))

 F  S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""AC"",".E  D

 . S ORIFN=+$P(ORIDX,",",5),ORDA=+$P(ORIDX,",",6)

 . S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR8=$G(^(8,ORDA,0))

 . I $P(OR8,U,15)=12 D SETALL^ORDD100(ORIFN) Q  ;reset AC xref

 . I $P(OR0,U,14)=ORPSJ,$P(OR8,U,2)="XX",$P(OR3,U,7)=ORDA D MSG^ORMBLD(ORIFN_";"_ORDA,"NA") ;update order number

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORY129   1289     printed  Apr 09, 2024@21:42:49                                                                                                                                                                                                      Page 2

ORY129    ;SLC/MKB - Postinit for patch OR*3*129 ;12/11/01  11:04

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**129**;Dec 17, 1997

 +2       ;

POST      ; -- postinit

 +1        NEW IFN,X

           SET IFN=+$PIECE($GET(^OR(100,0)),U,3)

 +2        FOR 

               SET IFN=$ORDER(^OR(100,IFN))

               if IFN?1"A".E

                   QUIT 

               IF IFN[";"

                   SET X=$GET(^(IFN,5))

                   if $LENGTH(X)

                       SET ^OR(100,+IFN,5)=X

                   KILL ^OR(100,IFN,5)

 +3        DO TASK

 +4        QUIT 

 +5       ;

TASK      ; -- task cleanup of AC xref

 +1        NEW ORMSG,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK

 +2        SET ORMSG(1)="Please queue the background job to clean up changed orders in the"

           SET ORMSG(2)="Active Orders index on file #100."

 +3        DO MES^XPDUTL(.ORMSG)

           KILL ORMSG

 +4        SET ZTDESC="Cleanup AC xref on Orders file #100"

           SET ZTIO=""

 +5        SET ZTRTN="EN^ORY129"

           DO ^%ZTLOAD

 +6        SET ORMSG="Task "_$SELECT($GET(ZTSK):"#"_ZTSK,1:"not")_" queued."

 +7        DO MES^XPDUTL(ORMSG)

           IF '$GET(ZTSK)

               DO BMES^XPDUTL("Use TASK^ORY129 to run this job later, if needed.")

 +8        QUIT 

 +9       ;

EN        ; -- main conversion loop

 +1        NEW ORIDX,ORPSJ,ORIFN,ORDA,OR0,OR3,OR8

 +2        SET ORIDX="^OR(100,""AC"")"

           SET ORPSJ=+$ORDER(^DIC(9.4,"C","PSJ",0))

 +3        FOR 

               SET ORIDX=$QUERY(@ORIDX)

               if ORIDX'?1"^OR(100,""AC"",".E

                   QUIT 

               Begin DoDot:1

 +4                SET ORIFN=+$PIECE(ORIDX,",",5)

                   SET ORDA=+$PIECE(ORIDX,",",6)

 +5                SET OR0=$GET(^OR(100,ORIFN,0))

                   SET OR3=$GET(^(3))

                   SET OR8=$GET(^(8,ORDA,0))

 +6       ;reset AC xref

                   IF $PIECE(OR8,U,15)=12

                       DO SETALL^ORDD100(ORIFN)

                       QUIT 

 +7       ;update order number

                   IF $PIECE(OR0,U,14)=ORPSJ

                       IF $PIECE(OR8,U,2)="XX"

                           IF $PIECE(OR3,U,7)=ORDA

                               DO MSG^ORMBLD(ORIFN_";"_ORDA,"NA")

               End DoDot:1

 +8        QUIT