ORY434 ;ISL/JLC - ENVIRONMENT CHECK FOR CPRS VERSION 31A ;06/27/17
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434**;Dec 17, 1997;Build 35
 ;
 ;
 Q
POST ;;SET THE MOB DLL VERSION
 ;D PUT^XPAR("PKG","OR MOB DLL VERSION",1,"2.0.17.0")
 D PUT^XPAR("PKG","OR MOB DLL NAME",1,"OrderCom.dll")
 I $$PATCH^XPDUTL("SD*5.3*671") D ADD^XPDPROT("OR EVSEND SD","SD RECEIVE OR","",1)
 N TEXT
 S TEXT(1)=" "
 S TEXT(2)="  Adding 'Clinic Scheduling' Display Group to"
 S TEXT(3)="  the 'All Services' Display Group..."
 D MES^XPDUTL(.TEXT)
 D SETDG
 D MES^XPDUTL("  DONE")
 S TEXT(1)=" "
 S TEXT(2)="  Adding 'Clinic Scheduling' Display Group to"
 S TEXT(3)="  parameter 'ORWOR CATEGORY SEQUENCE'..."
 D MES^XPDUTL(.TEXT)
 D SETPAR
 D MES^XPDUTL("  DONE")
 ;SEND NEW NOTIFICATION
 N ENT,EXIT,INST,ORMSG,LINE,ORI
 D BMES^XPDUTL("  Loading parameter values for new notification...")
 S ENT="PKG.ORDER ENTRY/RESULTS REPORTING"
 S ORI=91 D  S EXIT=0
 . F LINE=1:1 Q:$G(EXIT)  D
 .. N TEXT,ORERROR
 .. S TEXT=$P($T(PARAM+LINE),";;",2)
 .. S INST=$P($G(^ORD(100.9,ORI,0)),U,1)
 .. I $P(TEXT," ")="ORB" D  Q
 ... D EN^XPAR(ENT,$P(TEXT,U),INST,$P(TEXT,U,2),.ORERROR)  ;ICR #2336
 ... I +ORERROR D
 .... S ORMSG(1)=" ",EXIT=2
 .... S ORMSG(2)="ERROR: Unable to configure the new "_INST_" notification"
 .... S ORMSG(3)="Kernel Parameter Tools Error #"_+ORERROR_": "_$P(ORERROR,U,2)
 .... D BMES^XPDUTL(.ORMSG)
 .. I TEXT="" S EXIT=1
 D:$G(EXIT)<2 MES^XPDUTL("  Finished loading new notification values")
 Q
PARAM ;PARAMETER VALUES TO LOAD
 ;;ORB ARCHIVE PERIOD^30
 ;;ORB DELETE MECHANISM^Individual Recipient
 ;;ORB FORWARD BACKUP REVIEWER^0
 ;;ORB FORWARD SUPERVISOR^0
 ;;ORB FORWARD SURROGATES^0
 ;;ORB PROCESSING FLAG^Disabled
 ;;ORB PROVIDER RECIPIENTS^O
 ;;ORB URGENCY^High
 Q
SETDG ;
 N DA,DIC,DLAYGO,ORDG,X
 S ORDG=$O(^ORD(100.98,"B","ALL SERVICES",0)) Q:'ORDG
 S X=$O(^ORD(100.98,"B","CLINIC SCHEDULING",0)),DA(1)=ORDG I 'X D MES^XPDUTL("  'Clinic Scheduling' display group not found") Q
 I $O(^ORD(100.98,DA(1),1,"B",X,0)) D MES^XPDUTL("  Display group already attached")  Q  ;not first install - done.
 S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
 S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="NLX",DLAYGO=100.98
 S X="CLINIC SCHEDULING" D ^DIC
 Q
SETPAR ;
 N X
 I '$D(^ORD(100.98,"B","CLINIC SCHEDULING")) D MES^XPDUTL("  Display group already attached") Q
 S X=0,X=$O(^ORD(100.98,"B","CLINIC SCHEDULING",X)) Q:'X  D
 . D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",135,X)
 Q
SENDDLG(ANAME) ;Entries from 101.41 to send
 ;I ANAME="OR GTX CLINIC LOCATION" Q 1
 I ANAME="OR GTX SD COMMENT" Q 1
 I ANAME="OR GTX APPT NUM" Q 1
 I ANAME="OR GTX SCH INTERVAL" Q 1
 I ANAME="OR GTX PRE REQ" Q 1
 I ANAME="SD RTC" Q 1
 Q 0
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY434   2767     printed  Sep 23, 2025@20:18:40                                                                                                                                                                                                      Page 2
ORY434    ;ISL/JLC - ENVIRONMENT CHECK FOR CPRS VERSION 31A ;06/27/17
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434**;Dec 17, 1997;Build 35
 +2       ;
 +3       ;
 +4        QUIT 
POST      ;;SET THE MOB DLL VERSION
 +1       ;D PUT^XPAR("PKG","OR MOB DLL VERSION",1,"2.0.17.0")
 +2        DO PUT^XPAR("PKG","OR MOB DLL NAME",1,"OrderCom.dll")
 +3        IF $$PATCH^XPDUTL("SD*5.3*671")
               DO ADD^XPDPROT("OR EVSEND SD","SD RECEIVE OR","",1)
 +4        NEW TEXT
 +5        SET TEXT(1)=" "
 +6        SET TEXT(2)="  Adding 'Clinic Scheduling' Display Group to"
 +7        SET TEXT(3)="  the 'All Services' Display Group..."
 +8        DO MES^XPDUTL(.TEXT)
 +9        DO SETDG
 +10       DO MES^XPDUTL("  DONE")
 +11       SET TEXT(1)=" "
 +12       SET TEXT(2)="  Adding 'Clinic Scheduling' Display Group to"
 +13       SET TEXT(3)="  parameter 'ORWOR CATEGORY SEQUENCE'..."
 +14       DO MES^XPDUTL(.TEXT)
 +15       DO SETPAR
 +16       DO MES^XPDUTL("  DONE")
 +17      ;SEND NEW NOTIFICATION
 +18       NEW ENT,EXIT,INST,ORMSG,LINE,ORI
 +19       DO BMES^XPDUTL("  Loading parameter values for new notification...")
 +20       SET ENT="PKG.ORDER ENTRY/RESULTS REPORTING"
 +21       SET ORI=91
           Begin DoDot:1
 +22           FOR LINE=1:1
                   if $GET(EXIT)
                       QUIT 
                   Begin DoDot:2
 +23                   NEW TEXT,ORERROR
 +24                   SET TEXT=$PIECE($TEXT(PARAM+LINE),";;",2)
 +25                   SET INST=$PIECE($GET(^ORD(100.9,ORI,0)),U,1)
 +26                   IF $PIECE(TEXT," ")="ORB"
                           Begin DoDot:3
 +27      ;ICR #2336
                               DO EN^XPAR(ENT,$PIECE(TEXT,U),INST,$PIECE(TEXT,U,2),.ORERROR)
 +28                           IF +ORERROR
                                   Begin DoDot:4
 +29                                   SET ORMSG(1)=" "
                                       SET EXIT=2
 +30                                   SET ORMSG(2)="ERROR: Unable to configure the new "_INST_" notification"
 +31                                   SET ORMSG(3)="Kernel Parameter Tools Error #"_+ORERROR_": "_$PIECE(ORERROR,U,2)
 +32                                   DO BMES^XPDUTL(.ORMSG)
                                   End DoDot:4
                           End DoDot:3
                           QUIT 
 +33                   IF TEXT=""
                           SET EXIT=1
                   End DoDot:2
           End DoDot:1
           SET EXIT=0
 +34       if $GET(EXIT)<2
               DO MES^XPDUTL("  Finished loading new notification values")
 +35       QUIT 
PARAM     ;PARAMETER VALUES TO LOAD
 +1       ;;ORB ARCHIVE PERIOD^30
 +2       ;;ORB DELETE MECHANISM^Individual Recipient
 +3       ;;ORB FORWARD BACKUP REVIEWER^0
 +4       ;;ORB FORWARD SUPERVISOR^0
 +5       ;;ORB FORWARD SURROGATES^0
 +6       ;;ORB PROCESSING FLAG^Disabled
 +7       ;;ORB PROVIDER RECIPIENTS^O
 +8       ;;ORB URGENCY^High
 +9        QUIT 
SETDG     ;
 +1        NEW DA,DIC,DLAYGO,ORDG,X
 +2        SET ORDG=$ORDER(^ORD(100.98,"B","ALL SERVICES",0))
           if 'ORDG
               QUIT 
 +3        SET X=$ORDER(^ORD(100.98,"B","CLINIC SCHEDULING",0))
           SET DA(1)=ORDG
           IF 'X
               DO MES^XPDUTL("  'Clinic Scheduling' display group not found")
               QUIT 
 +4       ;not first install - done.
           IF $ORDER(^ORD(100.98,DA(1),1,"B",X,0))
               DO MES^XPDUTL("  Display group already attached")
               QUIT 
 +5        if '$DATA(^ORD(100.98,DA(1),1,0))
               SET ^(0)="^100.981P^^"
 +6        SET DIC="^ORD(100.98,"_DA(1)_",1,"
           SET DIC(0)="NLX"
           SET DLAYGO=100.98
 +7        SET X="CLINIC SCHEDULING"
           DO ^DIC
 +8        QUIT 
SETPAR    ;
 +1        NEW X
 +2        IF '$DATA(^ORD(100.98,"B","CLINIC SCHEDULING"))
               DO MES^XPDUTL("  Display group already attached")
               QUIT 
 +3        SET X=0
           SET X=$ORDER(^ORD(100.98,"B","CLINIC SCHEDULING",X))
           if 'X
               QUIT 
           Begin DoDot:1
 +4            DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",135,X)
           End DoDot:1
 +5        QUIT 
SENDDLG(ANAME) ;Entries from 101.41 to send
 +1       ;I ANAME="OR GTX CLINIC LOCATION" Q 1
 +2        IF ANAME="OR GTX SD COMMENT"
               QUIT 1
 +3        IF ANAME="OR GTX APPT NUM"
               QUIT 1
 +4        IF ANAME="OR GTX SCH INTERVAL"
               QUIT 1
 +5        IF ANAME="OR GTX PRE REQ"
               QUIT 1
 +6        IF ANAME="SD RTC"
               QUIT 1
 +7        QUIT 0