ORSETUP.m

ORSETUP ; SLC/MKB - OE3 Setup post-init ;7/26/97  15:51

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

PARAM ; -- Populate Parameters file

 D BMES^XPDUTL("Populating Parameters file ...")

 D ^ORXPAR,^ORPFCNVT

 Q

 ;

DGROUPS ; -- Update Display Group file

 D BMES^XPDUTL("Setting up Display Group file ...")

 D POST^ORSET98

 Q

 ;

ORDITMS ; -- Populate Orderable Items file

 ;N ORP S ORP=+$$PARCP^XPDUTL(ORCP) Q:ORP<0  ; already completed

 D BMES^XPDUTL("Populating Orderable Items file ...") ;G @ORP

0 D OI^ORSETUP1 ;I '$D(^ORD(101.43,"S.NURS")) S XPDQUIT=1 Q

 ;S ORP=$$UPCP^XPDUTL(ORCP,1) W:IOST?1"C-".E "."

1 D EN^GMRCPOS1 ;I '$D(^ORD(101.43,"S.CSLT")) S XPDQUIT=1 Q

 ;S ORP=$$UPCP^XPDUTL(ORCP,2) W:IOST?1"C-".E "."

2 D ^FHWORI ;I '$D(^ORD(101.43,"S.DIET")) S XPDQUIT=1 Q

 ;S ORP=$$UPCP^XPDUTL(ORCP,3) W:IOST?1"C-".E "."

3 D ALL^LR7OV2 ;I '$D(^ORD(101.43,"S.LAB")) S XPDQUIT=1 Q

 ;S ORP=$$UPCP^XPDUTL(ORCP,4) W:IOST?1"C-".E "."

4 D EN1^PSSHL1 ;I '$D(^ORD(101.43,"S.RX")) S XPDQUIT=1 Q

 ;S ORP=$$UPCP^XPDUTL(ORCP,5) W:IOST?1"C-".E "."

5 D ENALL^RAO7MFN ;I '$D(^ORD(101.43,"S.XRAY")) S XPDQUIT=1 Q

 ;S ORP=$$UPCP^XPDUTL(ORCP,-1) W:IOST?1"C-".E "."

 Q

 ;

DIALOGS ; -- Convert protocol menus, quick orders into Dialogs

 D BMES^XPDUTL("Converting protocol menus ...")

 D FRMT,^ORCONVRT

 Q

 ;

FRMT ; -- resolve format code ptrs for LR,PS dlgs

 N ORI,X,DLG,DA

 F ORI=1:1 S X=$T(DLG+ORI),X=$P(X,";",3) Q:X="ZZZZ"  D

 . S DLG=+$O(^ORD(101.41,"AB",$P(X,U),0)) Q:'DLG

 . S DA=+$O(^ORD(101.41,DLG,10,"B",$P(X,U,2),0)) Q:'DA

 . S $P(^ORD(101.41,DLG,10,DA,2),U,2)=$P(X,U,3)_+$O(^ORD(101.41,"AB",$P(X,U,4),0))

 Q

 ;

DLG ;; dialog^item position^item to use instead

 ;;LR OTHER LAB TESTS^4^=^OR GTX COLLECTION SAMPLE

 ;;PSO OERR^1^@^OR GTX INSTRUCTIONS

 ;;ZZZZ

 ;

URG ; -- set GMRCURGENCY protocols into 101.42

 N LAST,NAME,X,Y,DIC,DINUM,DLAYGO,I,CODE

 D BMES^XPDUTL("Adding Consult/Request urgencies to Order Urgency file ...")

 S DIC="^ORD(101.42,",DIC(0)="LX",DLAYGO=101.42

 S LAST=$O(^ORD(101.42,99),-1),NAME="GMRCURGENCY - "

 F  S NAME=$O(^ORD(101,"B",NAME)) Q:NAME'?1"GMRCURGENCY - ".E  S X=$P(NAME," - ",2) I '$D(^ORD(101.42,"B",X)) D

 . S DINUM=LAST+1 D FILE^DICN S:+Y>0 LAST=+Y S CODE=""

 . I Y'>0 D MES^XPDUTL(">>> Unable to add "_X_" urgency") Q

 . F I=1:1:4 I '$D(^ORD(101.42,"C","Z"_$E(X,1,I))) S CODE="Z"_$E(X,1,I) Q

 . S:$L(CODE) $P(^ORD(101.42,+Y,0),U,2)=CODE,^ORD(101.42,"C",CODE,+Y)=""

 Q

ORSETUP   ; SLC/MKB - OE3 Setup post-init ;7/26/97  15:51

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

PARAM     ; -- Populate Parameters file

 +1        DO BMES^XPDUTL("Populating Parameters file ...")

 +2        DO ^ORXPAR

           DO ^ORPFCNVT

 +3        QUIT 

 +4       ;

DGROUPS   ; -- Update Display Group file

 +1        DO BMES^XPDUTL("Setting up Display Group file ...")

 +2        DO POST^ORSET98

 +3        QUIT 

 +4       ;

ORDITMS   ; -- Populate Orderable Items file

 +1       ;N ORP S ORP=+$$PARCP^XPDUTL(ORCP) Q:ORP<0  ; already completed

 +2       ;G @ORP

           DO BMES^XPDUTL("Populating Orderable Items file ...")

0         ;I '$D(^ORD(101.43,"S.NURS")) S XPDQUIT=1 Q

           DO OI^ORSETUP1

 +1       ;S ORP=$$UPCP^XPDUTL(ORCP,1) W:IOST?1"C-".E "."

1         ;I '$D(^ORD(101.43,"S.CSLT")) S XPDQUIT=1 Q

           DO EN^GMRCPOS1

 +1       ;S ORP=$$UPCP^XPDUTL(ORCP,2) W:IOST?1"C-".E "."

2         ;I '$D(^ORD(101.43,"S.DIET")) S XPDQUIT=1 Q

           DO ^FHWORI

 +1       ;S ORP=$$UPCP^XPDUTL(ORCP,3) W:IOST?1"C-".E "."

3         ;I '$D(^ORD(101.43,"S.LAB")) S XPDQUIT=1 Q

           DO ALL^LR7OV2

 +1       ;S ORP=$$UPCP^XPDUTL(ORCP,4) W:IOST?1"C-".E "."

4         ;I '$D(^ORD(101.43,"S.RX")) S XPDQUIT=1 Q

           DO EN1^PSSHL1

 +1       ;S ORP=$$UPCP^XPDUTL(ORCP,5) W:IOST?1"C-".E "."

5         ;I '$D(^ORD(101.43,"S.XRAY")) S XPDQUIT=1 Q

           DO ENALL^RAO7MFN

 +1       ;S ORP=$$UPCP^XPDUTL(ORCP,-1) W:IOST?1"C-".E "."

 +2        QUIT 

 +3       ;

DIALOGS   ; -- Convert protocol menus, quick orders into Dialogs

 +1        DO BMES^XPDUTL("Converting protocol menus ...")

 +2        DO FRMT

           DO ^ORCONVRT

 +3        QUIT 

 +4       ;

FRMT      ; -- resolve format code ptrs for LR,PS dlgs

 +1        NEW ORI,X,DLG,DA

 +2        FOR ORI=1:1

               SET X=$TEXT(DLG+ORI)

               SET X=$PIECE(X,";",3)

               IF X="ZZZZ"

                   QUIT 

               Begin DoDot:1

 +3                SET DLG=+$ORDER(^ORD(101.41,"AB",$PIECE(X,U),0))

                   IF 'DLG

                       QUIT 

 +4                SET DA=+$ORDER(^ORD(101.41,DLG,10,"B",$PIECE(X,U,2),0))

                   IF 'DA

                       QUIT 

 +5                SET $PIECE(^ORD(101.41,DLG,10,DA,2),U,2)=$PIECE(X,U,3)_+$ORDER(^ORD(101.41,"AB",$PIECE(X,U,4),0))

               End DoDot:1

 +6        QUIT 

 +7       ;

DLG       ;; dialog^item position^item to use instead

 +1       ;;LR OTHER LAB TESTS^4^=^OR GTX COLLECTION SAMPLE

 +2       ;;PSO OERR^1^@^OR GTX INSTRUCTIONS

 +3       ;;ZZZZ

 +4       ;

URG       ; -- set GMRCURGENCY protocols into 101.42

 +1        NEW LAST,NAME,X,Y,DIC,DINUM,DLAYGO,I,CODE

 +2        DO BMES^XPDUTL("Adding Consult/Request urgencies to Order Urgency file ...")

 +3        SET DIC="^ORD(101.42,"

           SET DIC(0)="LX"

           SET DLAYGO=101.42

 +4        SET LAST=$ORDER(^ORD(101.42,99),-1)

           SET NAME="GMRCURGENCY - "

 +5        FOR 

               SET NAME=$ORDER(^ORD(101,"B",NAME))

               IF NAME'?1"GMRCURGENCY - ".E

                   QUIT 

               SET X=$PIECE(NAME," - ",2)

               IF '$DATA(^ORD(101.42,"B",X))

                   Begin DoDot:1

 +6                    SET DINUM=LAST+1

                       DO FILE^DICN

                       IF +Y>0

                           SET LAST=+Y

                       SET CODE=""

 +7                    IF Y'>0

                           DO MES^XPDUTL(">>> Unable to add "_X_" urgency")

                           QUIT 

 +8                    FOR I=1:1:4

                           IF '$DATA(^ORD(101.42,"C","Z"_$EXTRACT(X,1,I)))

                               SET CODE="Z"_$EXTRACT(X,1,I)

                               QUIT 

 +9                    IF $LENGTH(CODE)

                           SET $PIECE(^ORD(101.42,+Y,0),U,2)=CODE

                           SET ^ORD(101.42,"C",CODE,+Y)=""

                   End DoDot:1

 +10       QUIT