ORY195 ;SLCOIFO - Pre and Post-init for patch OR*3*195 [10/4/04 7:21am] ; [1/20/05 9:26am]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
;
PRE ; initiate pre-init processes
;
; Dump previously-installed param templates w/bad "B" x-ref entries:
;
N DA,DIK
;
S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (DIVISION)",0))
I +DA>0 S DIK="^XTV(8989.52," D ^DIK
;
S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SERVICE)",0))
I +DA>0 S DIK="^XTV(8989.52," D ^DIK
;
S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SYSTEM)",0))
I +DA>0 S DIK="^XTV(8989.52," D ^DIK
;
S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (USER)",0))
I +DA>0 S DIK="^XTV(8989.52," D ^DIK
;
Q
;
POST ; initiate post-init processes
;
I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
I +$$PATCH^XPDUTL("OR*3.0*222") D GNRPCS
I +$$PATCH^XPDUTL("MAG*3.0*7") D MAGRPC1
I +$$PATCH^XPDUTL("MAG*3.0*37") D MAGRPC2
D SETIMO
D PARVAL
D STUFDTRG
D MAIL
D Q^ORY195A ;Queue lab order check routine
Q
;
MAIL ; send bulletin of installation time
N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
S COUNT=0,XMDUZ="CPRS PACKAGE",XMTEXT="TEXT("
S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"
F I="G.CPRS GUI INSTALL@ISC-SLC.VA.GOV",DUZ S XMY(I)=""
;
S X=$P($T(VERSION),";;",2)
D LINE("Version "_X_" has been installed.")
D LINE(" ")
D LINE("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT()))
;
D ^XMD
Q
;
LINE(DATA) ; set text into array
S COUNT=COUNT+1
S TEXT(COUNT)=DATA
Q
;
SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present
N MENU,RPC
S MENU="OR CPRS GUI CHART"
F RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES","TIU GET DOCUMENTS FOR REQUEST" D INSERT(MENU,RPC)
Q
;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
; Input -- OPTION Option file (#19) Name field (#.01)
; RPC RPC sub-file (#19.05) RPC field (#.01)
; Output -- None
N FDA,FDAIEN,ERR,DIERR
S FDA(19,"?1,",.01)=OPTION
S FDA(19.05,"?+2,?1,",.01)=RPC
D UPDATE^DIE("E","FDA","FDAIEN","ERR")
Q
;
SETIMO ; Create "CLINIC MEDICATIONS" display group
N NDATA,DLG,IEN,X
S (NDATA,DLG,IEN,X)=""
S NDATA="CLINIC MEDICATIONS^Clin. Meds^C RX^"
N DIC
S DIC="^ORD(100.98,",DIC(0)="BX",X=$P(NDATA,U)
D ^DIC
I Y'=-1 S ^ORD(100.98,+Y,0)=NDATA Q
I Y=-1 S DIC(0)="L" D ^DIC
S DIC(0)="BX" D ^DIC
S IEN=+Y
I 'IEN Q
N DIE,DA,DR
S DIE="^ORD(100.98,",DA=IEN,DR="2///Clin. Meds;3///C RX"
D ^DIE
N DLAYGO
S DA(1)=$O(^ORD(100.98,"B","PHARMACY",0)) Q:'DA(1)
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 MEDICATIONS" D ^DIC
K Y
Q
PARVAL ;add Clin. Meds display group to SEQUENCE parameter
N X
Q:'$D(^ORD(100.98,"B","CLINIC MEDICATIONS"))
S X=0,X=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",X)) Q:'X D
. D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69,X)
Q
;
SCH ; -- Adjust admin schedule Help Msg for Non-Std Schedules
N SCH,I,DG,PKG,IPKG,DLG,PRMT,OR0
S SCH=+$O(^ORD(101.41,"B","OR GTX SCHEDULE",0)) Q:SCH<1
F I="I","UD","O","C" S X=+$O(^ORD(100.98,"B",I_" RX",0)) S:X DG(X)=""
F I="RX","SPLY" S X=+$O(^ORD(100.98,"B",I,0)) S:X DG(X)=""
F PKG="PSJ","PSO","PSS" D
. S IPKG=+$O(^DIC(9.4,"C",PKG,0))
. S DLG=0 F S DLG=+$O(^ORD(101.41,"APKG",IPKG,DLG)) Q:DLG<1 D
.. S OR0=$G(^ORD(101.41,DLG,0)) Q:$P(OR0,U,4)'="D" Q:'$D(DG($P(OR0,U,5)))
.. S PRMT=+$O(^ORD(101.41,DLG,10,"D",SCH,0)) Q:PRMT<1
.. S ^ORD(101.41,DLG,10,PRMT,1)="Enter a standard administration schedule."
Q
;
STUFDTRG ; Stuff existing date ranges into new parameters for CS and PCE.
;
; Get existing settings, stuff into new parameters.
;
; NOTE: ORQQCSDR params will allow "T, T+, T- settings.
; ORQQEAPT params allow single value number entries only.
;
N ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORSTART,ORSTOP,ORVAL
;
; First deal with PKG level settings.
;
; Clean out any existing settings:
D NDEL^XPAR("PKG","ORQQEAPT ENC APPT START",.ORERR)
D NDEL^XPAR("PKG","ORQQEAPT ENC APPT STOP",.ORERR)
D NDEL^XPAR("PKG","ORQQCSDR CS RANGE START",.ORERR)
D NDEL^XPAR("PKG","ORQQCSDR CS RANGE STOP",.ORERR)
;
; Get settings of previously-used high level params:
S ORSTART=$$GET^XPAR("DIV^SYS^PKG","ORQQVS SEARCH RANGE START",1,"I")
I '$L(ORSTART) S ORSTART=90
S ORSTOP=$$GET^XPAR("DIV^SYS^PKG","ORQQAP SEARCH RANGE STOP",1,"I")
I '$L(ORSTOP) S ORSTOP=90
;
; Stuff retrieved values into PKG level of first set of new params:
D EN^XPAR("PKG","ORQQCSDR CS RANGE START",1,ORSTART)
D EN^XPAR("PKG","ORQQCSDR CS RANGE STOP",1,ORSTOP)
;
; Treat "start" value and stuff it:
S ORVAL=ORSTART,ORNEG=0
I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
S ORVAL=+ORVAL
I 'ORNEG S ORVAL=0 ; Can't have later than "Today" for "start."
D EN^XPAR("PKG","ORQQEAPT ENC APPT START",1,ORVAL)
;
; Treat "stop" value and stuff it:
S ORVAL=ORSTOP,ORNEG=0
I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
S ORVAL=+ORVAL
I ORNEG S ORVAL=0 ; Won't allow earlier than "Today" for "stop."
D EN^XPAR("PKG","ORQQEAPT ENC APPT STOP",1,ORSTOP)
;
; Deal with User level settings.
;
S (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
;
; Begin with the START parameter:
D ENVAL^XPAR(.ORLST,"ORQQAP SEARCH RANGE START",1,.ORERR)
I 'ORERR,$G(ORLST)>0 D
.F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) D
..S ORBZ=$P(ORBE,";",2)
..I ORBZ="VA(200," S ORDUZ=$P(ORBE,";") I $L($G(ORDUZ)) D
...S ORVAL=ORLST(ORBE,1) ; Current setting.
...;
...; Eliminate any existing entries:
...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",.ORERR)
...;
...; Stuff value:
...D EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",1,ORVAL)
...;
...; Treat value:
...S ORNEG=0
...I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
...I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
...I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
...I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
...S ORVAL=+ORVAL
...I 'ORNEG S ORVAL=0 ; Can't have later than "Today" for "start."
...;
...; Eliminate any existing entries:
...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",.ORERR)
...;
...; Stuff value:
...D EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",1,ORVAL)
;
; Now do the STOP parameter:
S (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
;
D ENVAL^XPAR(.ORLST,"ORQQVS SEARCH RANGE STOP",1,.ORERR)
I 'ORERR,$G(ORLST)>0 D
.F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) D
..S ORBZ=$P(ORBE,";",2)
..I ORBZ="VA(200," S ORDUZ=$P(ORBE,";") I $L($G(ORDUZ)) D
...S ORVAL=ORLST(ORBE,1) ; Current setting.
...;
...; Eliminate any existing entries:
...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",.ORERR)
...;
...; Stuff value:
...D EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",1,ORVAL)
...;
...; Treat parameter value:
...S ORNEG=0
...I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
...I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
...I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
...I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
...S ORVAL=+ORVAL
...I ORNEG S ORVAL=0 ; Can't have earlier than "Today" for "stop."
...;
...; Eliminate any existing entries:
...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",.ORERR)
...;
...; Stuff value:
...D EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",1,ORVAL)
;
Q
;
GNRPCS ;
N MENU,I
S MENU="OR CPRS GUI CHART"
F I="ORWGN GNLOC","ORWGN AUTHUSR" D INSERT(MENU,I)
Q
;
MAGRPC1 ; Register Imaging RPC if MAG*3.0*7 present (DBIA 4526)
D INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
Q
;
MAGRPC2 ; Register Imaging RPCS if MAG*3.0*37 installed (DBIA 4528/4530)
D INSERT("OR CPRS GUI CHART","MAG IMPORT CHECK STATUS")
D INSERT("OR CPRS GUI CHART","MAG IMPORT CLEAR STATUS")
Q
;
VERSION ;;25.28
ORY195 ;SLCOIFO - Pre and Post-init for patch OR*3*195 [10/4/04 7:21am] ; [1/20/05 9:26am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
+2 ;
PRE ; initiate pre-init processes
+1 ;
+2 ; Dump previously-installed param templates w/bad "B" x-ref entries:
+3 ;
+4 NEW DA,DIK
+5 ;
+6 SET DA=$ORDER(^XTV(8989.52,"B","ORQQ SEARCH RANGE (DIVISION)",0))
+7 IF +DA>0
SET DIK="^XTV(8989.52,"
DO ^DIK
+8 ;
+9 SET DA=$ORDER(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SERVICE)",0))
+10 IF +DA>0
SET DIK="^XTV(8989.52,"
DO ^DIK
+11 ;
+12 SET DA=$ORDER(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SYSTEM)",0))
+13 IF +DA>0
SET DIK="^XTV(8989.52,"
DO ^DIK
+14 ;
+15 SET DA=$ORDER(^XTV(8989.52,"B","ORQQ SEARCH RANGE (USER)",0))
+16 IF +DA>0
SET DIK="^XTV(8989.52,"
DO ^DIK
+17 ;
+18 QUIT
+19 ;
POST ; initiate post-init processes
+1 ;
+2 IF +$$PATCH^XPDUTL("TIU*1.0*112")
DO SURGREG
+3 IF +$$PATCH^XPDUTL("OR*3.0*222")
DO GNRPCS
+4 IF +$$PATCH^XPDUTL("MAG*3.0*7")
DO MAGRPC1
+5 IF +$$PATCH^XPDUTL("MAG*3.0*37")
DO MAGRPC2
+6 DO SETIMO
+7 DO PARVAL
+8 DO STUFDTRG
+9 DO MAIL
+10 ;Queue lab order check routine
DO Q^ORY195A
+11 QUIT
+12 ;
MAIL ; send bulletin of installation time
+1 NEW COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
+2 SET COUNT=0
SET XMDUZ="CPRS PACKAGE"
SET XMTEXT="TEXT("
+3 SET XMSUB="Version "_$PIECE($TEXT(VERSION),";;",2)_" Installed"
+4 FOR I="G.CPRS GUI INSTALL@ISC-SLC.VA.GOV",DUZ
SET XMY(I)=""
+5 ;
+6 SET X=$PIECE($TEXT(VERSION),";;",2)
+7 DO LINE("Version "_X_" has been installed.")
+8 DO LINE(" ")
+9 DO LINE("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT()))
+10 ;
+11 DO ^XMD
+12 QUIT
+13 ;
LINE(DATA) ; set text into array
+1 SET COUNT=COUNT+1
+2 SET TEXT(COUNT)=DATA
+3 QUIT
+4 ;
SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present
+1 NEW MENU,RPC
+2 SET MENU="OR CPRS GUI CHART"
+3 FOR RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES","TIU GET DOCUMENTS FOR REQUEST"
DO INSERT(MENU,RPC)
+4 QUIT
+5 ;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
+1 ; Input -- OPTION Option file (#19) Name field (#.01)
+2 ; RPC RPC sub-file (#19.05) RPC field (#.01)
+3 ; Output -- None
+4 NEW FDA,FDAIEN,ERR,DIERR
+5 SET FDA(19,"?1,",.01)=OPTION
+6 SET FDA(19.05,"?+2,?1,",.01)=RPC
+7 DO UPDATE^DIE("E","FDA","FDAIEN","ERR")
+8 QUIT
+9 ;
SETIMO ; Create "CLINIC MEDICATIONS" display group
+1 NEW NDATA,DLG,IEN,X
+2 SET (NDATA,DLG,IEN,X)=""
+3 SET NDATA="CLINIC MEDICATIONS^Clin. Meds^C RX^"
+4 NEW DIC
+5 SET DIC="^ORD(100.98,"
SET DIC(0)="BX"
SET X=$PIECE(NDATA,U)
+6 DO ^DIC
+7 IF Y'=-1
SET ^ORD(100.98,+Y,0)=NDATA
QUIT
+8 IF Y=-1
SET DIC(0)="L"
DO ^DIC
+9 SET DIC(0)="BX"
DO ^DIC
+10 SET IEN=+Y
+11 IF 'IEN
QUIT
+12 NEW DIE,DA,DR
+13 SET DIE="^ORD(100.98,"
SET DA=IEN
SET DR="2///Clin. Meds;3///C RX"
+14 DO ^DIE
+15 NEW DLAYGO
+16 SET DA(1)=$ORDER(^ORD(100.98,"B","PHARMACY",0))
IF 'DA(1)
QUIT
+17 IF '$DATA(^ORD(100.98,DA(1),1,0))
SET ^(0)="^100.981P^^"
+18 SET DIC="^ORD(100.98,"_DA(1)_",1,"
SET DIC(0)="NLX"
SET DLAYGO=100.98
+19 SET X="CLINIC MEDICATIONS"
DO ^DIC
+20 KILL Y
+21 QUIT
PARVAL ;add Clin. Meds display group to SEQUENCE parameter
+1 NEW X
+2 IF '$DATA(^ORD(100.98,"B","CLINIC MEDICATIONS"))
QUIT
+3 SET X=0
SET X=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",X))
IF 'X
QUIT
Begin DoDot:1
+4 DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69,X)
End DoDot:1
+5 QUIT
+6 ;
SCH ; -- Adjust admin schedule Help Msg for Non-Std Schedules
+1 NEW SCH,I,DG,PKG,IPKG,DLG,PRMT,OR0
+2 SET SCH=+$ORDER(^ORD(101.41,"B","OR GTX SCHEDULE",0))
IF SCH<1
QUIT
+3 FOR I="I","UD","O","C"
SET X=+$ORDER(^ORD(100.98,"B",I_" RX",0))
IF X
SET DG(X)=""
+4 FOR I="RX","SPLY"
SET X=+$ORDER(^ORD(100.98,"B",I,0))
IF X
SET DG(X)=""
+5 FOR PKG="PSJ","PSO","PSS"
Begin DoDot:1
+6 SET IPKG=+$ORDER(^DIC(9.4,"C",PKG,0))
+7 SET DLG=0
FOR
SET DLG=+$ORDER(^ORD(101.41,"APKG",IPKG,DLG))
IF DLG<1
QUIT
Begin DoDot:2
+8 SET OR0=$GET(^ORD(101.41,DLG,0))
IF $PIECE(OR0,U,4)'="D"
QUIT
IF '$DATA(DG($PIECE(OR0,U,5)))
QUIT
+9 SET PRMT=+$ORDER(^ORD(101.41,DLG,10,"D",SCH,0))
IF PRMT<1
QUIT
+10 SET ^ORD(101.41,DLG,10,PRMT,1)="Enter a standard administration schedule."
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
STUFDTRG ; Stuff existing date ranges into new parameters for CS and PCE.
+1 ;
+2 ; Get existing settings, stuff into new parameters.
+3 ;
+4 ; NOTE: ORQQCSDR params will allow "T, T+, T- settings.
+5 ; ORQQEAPT params allow single value number entries only.
+6 ;
+7 NEW ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORSTART,ORSTOP,ORVAL
+8 ;
+9 ; First deal with PKG level settings.
+10 ;
+11 ; Clean out any existing settings:
+12 DO NDEL^XPAR("PKG","ORQQEAPT ENC APPT START",.ORERR)
+13 DO NDEL^XPAR("PKG","ORQQEAPT ENC APPT STOP",.ORERR)
+14 DO NDEL^XPAR("PKG","ORQQCSDR CS RANGE START",.ORERR)
+15 DO NDEL^XPAR("PKG","ORQQCSDR CS RANGE STOP",.ORERR)
+16 ;
+17 ; Get settings of previously-used high level params:
+18 SET ORSTART=$$GET^XPAR("DIV^SYS^PKG","ORQQVS SEARCH RANGE START",1,"I")
+19 IF '$LENGTH(ORSTART)
SET ORSTART=90
+20 SET ORSTOP=$$GET^XPAR("DIV^SYS^PKG","ORQQAP SEARCH RANGE STOP",1,"I")
+21 IF '$LENGTH(ORSTOP)
SET ORSTOP=90
+22 ;
+23 ; Stuff retrieved values into PKG level of first set of new params:
+24 DO EN^XPAR("PKG","ORQQCSDR CS RANGE START",1,ORSTART)
+25 DO EN^XPAR("PKG","ORQQCSDR CS RANGE STOP",1,ORSTOP)
+26 ;
+27 ; Treat "start" value and stuff it:
+28 SET ORVAL=ORSTART
SET ORNEG=0
+29 IF ORVAL["T"
SET ORVAL=$PIECE(ORVAL,"T",2)
+30 IF ORVAL["t"
SET ORVAL=$PIECE(ORVAL,"t",2)
+31 IF ORVAL["-"
SET ORNEG=1
SET ORVAL=$PIECE(ORVAL,"-",2)
+32 IF ORVAL["+"
SET ORVAL=$PIECE(ORVAL,"+",2)
+33 SET ORVAL=+ORVAL
+34 ; Can't have later than "Today" for "start."
IF 'ORNEG
SET ORVAL=0
+35 DO EN^XPAR("PKG","ORQQEAPT ENC APPT START",1,ORVAL)
+36 ;
+37 ; Treat "stop" value and stuff it:
+38 SET ORVAL=ORSTOP
SET ORNEG=0
+39 IF ORVAL["T"
SET ORVAL=$PIECE(ORVAL,"T",2)
+40 IF ORVAL["t"
SET ORVAL=$PIECE(ORVAL,"t",2)
+41 IF ORVAL["-"
SET ORNEG=1
SET ORVAL=$PIECE(ORVAL,"-",2)
+42 IF ORVAL["+"
SET ORVAL=$PIECE(ORVAL,"+",2)
+43 SET ORVAL=+ORVAL
+44 ; Won't allow earlier than "Today" for "stop."
IF ORNEG
SET ORVAL=0
+45 DO EN^XPAR("PKG","ORQQEAPT ENC APPT STOP",1,ORSTOP)
+46 ;
+47 ; Deal with User level settings.
+48 ;
+49 SET (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
+50 ;
+51 ; Begin with the START parameter:
+52 DO ENVAL^XPAR(.ORLST,"ORQQAP SEARCH RANGE START",1,.ORERR)
+53 IF 'ORERR
IF $GET(ORLST)>0
Begin DoDot:1
+54 FOR ORBX=1:1:ORLST
SET ORBE=$ORDER(ORLST(ORBE))
Begin DoDot:2
+55 SET ORBZ=$PIECE(ORBE,";",2)
+56 IF ORBZ="VA(200,"
SET ORDUZ=$PIECE(ORBE,";")
IF $LENGTH($GET(ORDUZ))
Begin DoDot:3
+57 ; Current setting.
SET ORVAL=ORLST(ORBE,1)
+58 ;
+59 ; Eliminate any existing entries:
+60 DO NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",.ORERR)
+61 ;
+62 ; Stuff value:
+63 DO EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",1,ORVAL)
+64 ;
+65 ; Treat value:
+66 SET ORNEG=0
+67 IF ORVAL["T"
SET ORVAL=$PIECE(ORVAL,"T",2)
+68 IF ORVAL["t"
SET ORVAL=$PIECE(ORVAL,"t",2)
+69 IF ORVAL["-"
SET ORNEG=1
SET ORVAL=$PIECE(ORVAL,"-",2)
+70 IF ORVAL["+"
SET ORVAL=$PIECE(ORVAL,"+",2)
+71 SET ORVAL=+ORVAL
+72 ; Can't have later than "Today" for "start."
IF 'ORNEG
SET ORVAL=0
+73 ;
+74 ; Eliminate any existing entries:
+75 DO NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",.ORERR)
+76 ;
+77 ; Stuff value:
+78 DO EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",1,ORVAL)
End DoDot:3
End DoDot:2
End DoDot:1
+79 ;
+80 ; Now do the STOP parameter:
+81 SET (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
+82 ;
+83 DO ENVAL^XPAR(.ORLST,"ORQQVS SEARCH RANGE STOP",1,.ORERR)
+84 IF 'ORERR
IF $GET(ORLST)>0
Begin DoDot:1
+85 FOR ORBX=1:1:ORLST
SET ORBE=$ORDER(ORLST(ORBE))
Begin DoDot:2
+86 SET ORBZ=$PIECE(ORBE,";",2)
+87 IF ORBZ="VA(200,"
SET ORDUZ=$PIECE(ORBE,";")
IF $LENGTH($GET(ORDUZ))
Begin DoDot:3
+88 ; Current setting.
SET ORVAL=ORLST(ORBE,1)
+89 ;
+90 ; Eliminate any existing entries:
+91 DO NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",.ORERR)
+92 ;
+93 ; Stuff value:
+94 DO EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",1,ORVAL)
+95 ;
+96 ; Treat parameter value:
+97 SET ORNEG=0
+98 IF ORVAL["T"
SET ORVAL=$PIECE(ORVAL,"T",2)
+99 IF ORVAL["t"
SET ORVAL=$PIECE(ORVAL,"t",2)
+100 IF ORVAL["-"
SET ORNEG=1
SET ORVAL=$PIECE(ORVAL,"-",2)
+101 IF ORVAL["+"
SET ORVAL=$PIECE(ORVAL,"+",2)
+102 SET ORVAL=+ORVAL
+103 ; Can't have earlier than "Today" for "stop."
IF ORNEG
SET ORVAL=0
+104 ;
+105 ; Eliminate any existing entries:
+106 DO NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",.ORERR)
+107 ;
+108 ; Stuff value:
+109 DO EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",1,ORVAL)
End DoDot:3
End DoDot:2
End DoDot:1
+110 ;
+111 QUIT
+112 ;
GNRPCS ;
+1 NEW MENU,I
+2 SET MENU="OR CPRS GUI CHART"
+3 FOR I="ORWGN GNLOC","ORWGN AUTHUSR"
DO INSERT(MENU,I)
+4 QUIT
+5 ;
MAGRPC1 ; Register Imaging RPC if MAG*3.0*7 present (DBIA 4526)
+1 DO INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
+2 QUIT
+3 ;
MAGRPC2 ; Register Imaging RPCS if MAG*3.0*37 installed (DBIA 4528/4530)
+1 DO INSERT("OR CPRS GUI CHART","MAG IMPORT CHECK STATUS")
+2 DO INSERT("OR CPRS GUI CHART","MAG IMPORT CLEAR STATUS")
+3 QUIT
+4 ;
VERSION ;;25.28
