Routine: ORY39

ORY39 ;SLC/JFR - POST-INSTALL OR*3*39 11/24/98 13:15

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

POST ; task AWID linetag in post-install

 S ZTDTH=$H,ZTRTN="AWID^ORY39",ZTDESC="Post-install for OR*3*39"

 S ZTIO="" D ^%ZTLOAD

 D BMES^XPDUTL($S($G(ZTSK):"Post-install tasked, Task # "_ZTSK,1:"Unable to queue post-install"))

 K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK

AWID ; loop whole order file

 ; set "AW" x-ref on NKA allergy orders

 ; add ID's to existing orders

 ;Q:$$PATCH^XPDUTL("OR*3.0*39")

 N NKADLG,ORIFN,ORDLG,ORFTXT,ORFTOI

 S ORDLG=$$PTR^ORCD("GMRAOR ALLERGY ENTER/EDIT")_";ORD(101.41," Q:'ORDLG

 S NKADLG=$$PTR^ORCD("OR GTX NKA")

 S ORFTXT=$$PTR^ORCD("OR GTX FREE TEXT 1")

 S ORFTOI=$$PTR^ORCD("OR GTX FREE TEXT OI")

 S ORIFN=0 F  S ORIFN=$O(^OR(100,ORIFN)) Q:'ORIFN  D

 . Q:$P($G(^OR(100,ORIFN,0)),"^",5)'=ORDLG  I $$NKA(ORIFN) D  Q

 .. N DA

 .. S DA=ORIFN D WS^ORDD100 ; set logic for "AW" x-ref

 . D COMMENT(ORIFN)

. Q

NKA(ORDER)      ; see if order is an NKA

 N RESP,NKA

 S NKA=0

 S RESP=0 F  S RESP=$O(^OR(100,ORDER,4.5,RESP)) Q:'RESP!NKA  D

 . I $P(^OR(100,ORDER,4.5,RESP,0),"^",2)=NKADLG D

 .. ; set "ID" x-ref for NKA on field 4.5 and NKA flag

 .. S NKA=1

 .. S $P(^OR(100,ORDER,4.5,RESP,0),"^",4)="NKA"

 .. S ^OR(100,ORDER,4.5,"ID","NKA",RESP)=""

. Q

 Q NKA

COMMENT(ORDER) ; replace COMMENT prompt with ITEM

 N RESP,ORX S RESP=0

 F  S RESP=$O(^OR(100,ORDER,4.5,"ID","COMMENT",RESP)) Q:RESP'>0  I $P($G(^OR(100,ORDER,4.5,RESP,0)),U,2)=ORFTXT S ORX=^(0) D

 . K ^OR(100,ORDER,4.5,"ID","COMMENT",RESP)

 . S $P(ORX,U,2)=ORFTOI,$P(ORX,U,4)="ITEM",^OR(100,ORDER,4.5,RESP,0)=ORX

 . S ^OR(100,ORDER,4.5,"ID","ITEM",RESP)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY39   1692     printed  Apr 09, 2024@21:43:42                                                                                                                                                                                                       Page 2

ORY39     ;SLC/JFR - POST-INSTALL OR*3*39 11/24/98 13:15

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

POST      ; task AWID linetag in post-install

 +1        SET ZTDTH=$HOROLOG

           SET ZTRTN="AWID^ORY39"

           SET ZTDESC="Post-install for OR*3*39"

 +2        SET ZTIO=""

           DO ^%ZTLOAD

 +3        DO BMES^XPDUTL($SELECT($GET(ZTSK):"Post-install tasked, Task # "_ZTSK,1:"Unable to queue post-install"))

 +4        KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK

 +5        QUIT

AWID      ; loop whole order file

 +1       ; set "AW" x-ref on NKA allergy orders

 +2       ; add ID's to existing orders

 +3       ;Q:$$PATCH^XPDUTL("OR*3.0*39")

 +4        NEW NKADLG,ORIFN,ORDLG,ORFTXT,ORFTOI

 +5        SET ORDLG=$$PTR^ORCD("GMRAOR ALLERGY ENTER/EDIT")_";ORD(101.41,"

           if 'ORDLG

               QUIT

 +6        SET NKADLG=$$PTR^ORCD("OR GTX NKA")

 +7        SET ORFTXT=$$PTR^ORCD("OR GTX FREE TEXT 1")

 +8        SET ORFTOI=$$PTR^ORCD("OR GTX FREE TEXT OI")

 +9        SET ORIFN=0

FOR

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

               if 'ORIFN

                   QUIT

               Begin DoDot:1

 +10               if $PIECE($GET(^OR(100,ORIFN,0)),"^",5)'=ORDLG

                       QUIT

                   IF $$NKA(ORIFN)

                       Begin DoDot:2

 +11                       NEW DA

 +12      ; set logic for "AW" x-ref

                           SET DA=ORIFN

                           DO WS^ORDD100

                       End DoDot:2

                       QUIT

 +13               DO COMMENT(ORIFN)

 +14               QUIT

               End DoDot:1

 +15       QUIT

NKA(ORDER) ; see if order is an NKA

 +1        NEW RESP,NKA

 +2        SET NKA=0

 +3        SET RESP=0

FOR

               SET RESP=$ORDER(^OR(100,ORDER,4.5,RESP))

               if 'RESP!NKA

                   QUIT

               Begin DoDot:1

 +4                IF $PIECE(^OR(100,ORDER,4.5,RESP,0),"^",2)=NKADLG

                       Begin DoDot:2

 +5       ; set "ID" x-ref for NKA on field 4.5 and NKA flag

 +6                        SET NKA=1

 +7                        SET $PIECE(^OR(100,ORDER,4.5,RESP,0),"^",4)="NKA"

 +8                        SET ^OR(100,ORDER,4.5,"ID","NKA",RESP)=""

                       End DoDot:2

 +9                QUIT

               End DoDot:1

 +10       QUIT NKA

COMMENT(ORDER) ; replace COMMENT prompt with ITEM

 +1        NEW RESP,ORX

           SET RESP=0

 +2        FOR

               SET RESP=$ORDER(^OR(100,ORDER,4.5,"ID","COMMENT",RESP))

               if RESP'>0

                   QUIT

               IF $PIECE($GET(^OR(100,ORDER,4.5,RESP,0)),U,2)=ORFTXT

                   SET ORX=^(0)

                   Begin DoDot:1

 +3                    KILL ^OR(100,ORDER,4.5,"ID","COMMENT",RESP)

 +4                    SET $PIECE(ORX,U,2)=ORFTOI

                       SET $PIECE(ORX,U,4)="ITEM"

                       SET ^OR(100,ORDER,4.5,RESP,0)=ORX

 +5                    SET ^OR(100,ORDER,4.5,"ID","ITEM",RESP)=""

                   End DoDot:1

 +6        QUIT

ORY39.m