ORY429 ; ISP/TC - Post Install Routine for OR*3.0*429 ;04/04/17 12:28
;;3.0;ORDER ENTRY/RESULTS REPORTING;**429**;Dec 17, 1997;Build 33
;
; External References:
; ICR 2263 ADD/EN^XPAR
; ICR 2971 ^GMPL(125,"C"
; ICR 10040 $$GET1^DIQ(44,ORCLIN,.01)
; ICR 10060 ^VA(200,"B"
; ICR 10141 MES^XPDUTL
;
DUPLIST(ORINVLST,ORLSTNM) ; Check invalid list for any duplicate entries
N ORLIST,ORDUP S ORLIST="",ORDUP=0
F S ORLIST=$O(ORINVLST(ORLIST)) Q:ORLIST="" D
. I ORLSTNM=ORLIST S ORDUP=1 Q
Q ORDUP
;
POST ; Post-install subroutine
;
N ORUSRMSG,ORCLNMSG,ORSYSMSG
Q:$$PATCH^XPDUTL("OR*3.0*429")
S ORUSRMSG(1)="Migrating default user Problem Selection list from NEW PERSON File to the"
S ORUSRMSG(2)="ORQQPL SELECTION LIST parameter..."
D MES^XPDUTL(.ORUSRMSG)
D SETUSRLT
S ORCLNMSG(1)=""
S ORCLNMSG(2)="Migrating default clinic Problem Selection list from PROBLEM SELECTION LIST"
S ORCLNMSG(3)="File to the ORQQPL SELECTION LIST parameter..."
D MES^XPDUTL(.ORCLNMSG)
D SETCLNLT
S ORSYSMSG(1)=""
S ORSYSMSG(2)="Setting system & package level for ORQQPL SELECTION LIST parameter to a default"
S ORSYSMSG(3)="VA National Selection List..."
D MES^XPDUTL(.ORSYSMSG)
D SETSYSPR
Q
;
PRNTERR(ORERR,ORACT,ORENTY,ORLSTNM) ; Print out any errors during migration
N ORTXT,ORFILE,ORENT
S ORENT=$S($P(ORENTY,U)="USR":"user",$P(ORENTY,U)="LOC":"clinic",$P(ORENTY,U)="SYS":"system",1:"package")
S ORTXT(1)=""
S ORTXT(2)=" "_ORACT_" failed for "_ORENT_$S($L($P(ORENTY,U,2))>0:": "_$P(ORENTY,U,2),1:"")
S ORTXT(3)=" Default list: "_ORLSTNM
S ORTXT(4)=" Error: "_$P(ORERR,U,2)
S ORTXT(5)=""
D MES^XPDUTL(.ORTXT)
Q
;
PRNTIERR(ORINVLST) ; Print out list with inactive codes
N ORTXT,ORLST
S ORTXT(1)=""
S ORTXT(2)=" The following selection lists could not be migrated to the ORQQPL SELECTION"
S ORTXT(3)=" LIST parameter because it contains one or more problems that have inactive"
S ORTXT(4)=" SNOMED and/or ICD codes attached to them."
S ORTXT(5)=""
D MES^XPDUTL(.ORTXT)
S ORLST=""
F S ORLST=$O(ORINVLST(ORLST)) Q:ORLST="" D MES^XPDUTL(" "_ORLST)
Q
;
SETCLNLT ; Migrate pre-existing clinic default list to ORQQPL SELECTION LIST param
N ORCLIN,ORLST,ORERR,ORLSTNM,ORINVLST,ORCLNNM,ORPRVCLN,ORDLM,ORPRVDLM,ORENTY,ORACT
S (ORCLIN,ORLST,ORPRVCLN,ORPRVDLM)=0,ORACT="Migration"
F S ORCLIN=$O(^GMPL(125,"C",ORCLIN)) Q:'ORCLIN D
. F S ORLST=$O(^GMPL(125,"C",ORCLIN,ORLST)) Q:'ORLST D
. . S ORLSTNM=$$GET1^DIQ(125,ORLST,.01)
. . Q:ORLSTNM=""
. . S ORCLNNM=$$GET1^DIQ(44,ORCLIN,.01)
. . S ORDLM=$$GET1^DIQ(125,ORLST,.02,"I")
. . I '$$VALLIST^GMPLBLD2(ORLST) D
. . . Q:$$DUPLIST(.ORINVLST,ORLSTNM)
. . . S ORINVLST(ORLSTNM)=""
. . E D
. . . I ORCLIN=ORPRVCLN D
. . . . I ORDLM>=ORPRVDLM D EN^XPAR("LOC."_ORCLNNM,"ORQQPL SELECTION LIST",1,ORLSTNM,.ORERR)
. . . E D EN^XPAR("LOC."_ORCLNNM,"ORQQPL SELECTION LIST",1,ORLSTNM,.ORERR)
. . I ORCLIN'=ORPRVCLN S ORPRVCLN=ORCLIN
. . I ORDLM'=ORPRVDLM S ORPRVDLM=ORDLM
. . S ORENTY="LOC^"_ORCLNNM
. . I +$G(ORERR)>0 D PRNTERR(ORERR,ORACT,ORENTY,ORLSTNM) K ORERR
I $D(ORINVLST) D PRNTIERR(.ORINVLST)
Q
;
SETSYSPR ; Set system & package level of ORQQPL SELECTION LIST param to VA National list
N ORLSTNM,ORSYSERR,ORPKGERR,ORACT,ORSENTY,ORPENTY
S ORLSTNM="",ORACT="Setting"
S ORSENTY="SYS^",ORPENTY="PKG^ORDER ENTRY/RESULTS REPORTING"
F S ORLSTNM=$O(^GMPL(125,"B",ORLSTNM)) Q:ORLSTNM="" D
. I $E(ORLSTNM,1,3)="VA-" D
. . D EN^XPAR("SYS","ORQQPL SELECTION LIST",1,ORLSTNM,.ORSYSERR)
. . D EN^XPAR("PKG","ORQQPL SELECTION LIST",1,ORLSTNM,.ORPKGERR)
. . I +$G(ORSYSERR)>0 D PRNTERR(ORSYSERR,ORACT,ORSENTY,ORLSTNM)
. . I +$G(ORPKGERR)>0 D PRNTERR(ORPKGERR,ORACT,ORPENTY,ORLSTNM)
Q
;
SETUSRLT ; Migrate pre-existing user default list to ORQQPL SELECTION LIST param
N ORDUZ,ORLST,ORLSTNM,ORUSR,ORERR,ORINVLST,ORENTY,ORACT
S (ORUSR,ORDUZ)="",ORACT="Migration"
F S ORUSR=$O(^VA(200,"B",ORUSR)) Q:ORUSR="" D
. F S ORDUZ=$O(^VA(200,"B",ORUSR,ORDUZ)) Q:ORDUZ="" D
. . S ORLST=$$GET1^DIQ(200,ORDUZ,125.1,"I")
. . Q:'ORLST
. . S ORLSTNM=$$GET1^DIQ(125,ORLST,.01)
. . I ($L(ORLSTNM)>0) D
. . . I '$$VALLIST^GMPLBLD2(ORLST) D
. . . . Q:$$DUPLIST(.ORINVLST,ORLSTNM)
. . . . S ORINVLST(ORLSTNM)=""
. . . E D ADD^XPAR(ORDUZ_";VA(200,","ORQQPL SELECTION LIST",1,ORLSTNM,.ORERR)
. . S ORENTY="USR^"_ORUSR
. . I +$G(ORERR)>0 D PRNTERR(ORERR,ORACT,ORENTY,ORLSTNM) K ORERR
I $D(ORINVLST) D PRNTIERR(.ORINVLST)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY429 4557 printed Nov 22, 2024@17:52:15 Page 2
ORY429 ; ISP/TC - Post Install Routine for OR*3.0*429 ;04/04/17 12:28
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**429**;Dec 17, 1997;Build 33
+2 ;
+3 ; External References:
+4 ; ICR 2263 ADD/EN^XPAR
+5 ; ICR 2971 ^GMPL(125,"C"
+6 ; ICR 10040 $$GET1^DIQ(44,ORCLIN,.01)
+7 ; ICR 10060 ^VA(200,"B"
+8 ; ICR 10141 MES^XPDUTL
+9 ;
DUPLIST(ORINVLST,ORLSTNM) ; Check invalid list for any duplicate entries
+1 NEW ORLIST,ORDUP
SET ORLIST=""
SET ORDUP=0
+2 FOR
SET ORLIST=$ORDER(ORINVLST(ORLIST))
if ORLIST=""
QUIT
Begin DoDot:1
+3 IF ORLSTNM=ORLIST
SET ORDUP=1
QUIT
End DoDot:1
+4 QUIT ORDUP
+5 ;
POST ; Post-install subroutine
+1 ;
+2 NEW ORUSRMSG,ORCLNMSG,ORSYSMSG
+3 if $$PATCH^XPDUTL("OR*3.0*429")
QUIT
+4 SET ORUSRMSG(1)="Migrating default user Problem Selection list from NEW PERSON File to the"
+5 SET ORUSRMSG(2)="ORQQPL SELECTION LIST parameter..."
+6 DO MES^XPDUTL(.ORUSRMSG)
+7 DO SETUSRLT
+8 SET ORCLNMSG(1)=""
+9 SET ORCLNMSG(2)="Migrating default clinic Problem Selection list from PROBLEM SELECTION LIST"
+10 SET ORCLNMSG(3)="File to the ORQQPL SELECTION LIST parameter..."
+11 DO MES^XPDUTL(.ORCLNMSG)
+12 DO SETCLNLT
+13 SET ORSYSMSG(1)=""
+14 SET ORSYSMSG(2)="Setting system & package level for ORQQPL SELECTION LIST parameter to a default"
+15 SET ORSYSMSG(3)="VA National Selection List..."
+16 DO MES^XPDUTL(.ORSYSMSG)
+17 DO SETSYSPR
+18 QUIT
+19 ;
PRNTERR(ORERR,ORACT,ORENTY,ORLSTNM) ; Print out any errors during migration
+1 NEW ORTXT,ORFILE,ORENT
+2 SET ORENT=$SELECT($PIECE(ORENTY,U)="USR":"user",$PIECE(ORENTY,U)="LOC":"clinic",$PIECE(ORENTY,U)="SYS":"system",1:"package")
+3 SET ORTXT(1)=""
+4 SET ORTXT(2)=" "_ORACT_" failed for "_ORENT_$SELECT($LENGTH($PIECE(ORENTY,U,2))>0:": "_$PIECE(ORENTY,U,2),1:"")
+5 SET ORTXT(3)=" Default list: "_ORLSTNM
+6 SET ORTXT(4)=" Error: "_$PIECE(ORERR,U,2)
+7 SET ORTXT(5)=""
+8 DO MES^XPDUTL(.ORTXT)
+9 QUIT
+10 ;
PRNTIERR(ORINVLST) ; Print out list with inactive codes
+1 NEW ORTXT,ORLST
+2 SET ORTXT(1)=""
+3 SET ORTXT(2)=" The following selection lists could not be migrated to the ORQQPL SELECTION"
+4 SET ORTXT(3)=" LIST parameter because it contains one or more problems that have inactive"
+5 SET ORTXT(4)=" SNOMED and/or ICD codes attached to them."
+6 SET ORTXT(5)=""
+7 DO MES^XPDUTL(.ORTXT)
+8 SET ORLST=""
+9 FOR
SET ORLST=$ORDER(ORINVLST(ORLST))
if ORLST=""
QUIT
DO MES^XPDUTL(" "_ORLST)
+10 QUIT
+11 ;
SETCLNLT ; Migrate pre-existing clinic default list to ORQQPL SELECTION LIST param
+1 NEW ORCLIN,ORLST,ORERR,ORLSTNM,ORINVLST,ORCLNNM,ORPRVCLN,ORDLM,ORPRVDLM,ORENTY,ORACT
+2 SET (ORCLIN,ORLST,ORPRVCLN,ORPRVDLM)=0
SET ORACT="Migration"
+3 FOR
SET ORCLIN=$ORDER(^GMPL(125,"C",ORCLIN))
if 'ORCLIN
QUIT
Begin DoDot:1
+4 FOR
SET ORLST=$ORDER(^GMPL(125,"C",ORCLIN,ORLST))
if 'ORLST
QUIT
Begin DoDot:2
+5 SET ORLSTNM=$$GET1^DIQ(125,ORLST,.01)
+6 if ORLSTNM=""
QUIT
+7 SET ORCLNNM=$$GET1^DIQ(44,ORCLIN,.01)
+8 SET ORDLM=$$GET1^DIQ(125,ORLST,.02,"I")
+9 IF '$$VALLIST^GMPLBLD2(ORLST)
Begin DoDot:3
+10 if $$DUPLIST(.ORINVLST,ORLSTNM)
QUIT
+11 SET ORINVLST(ORLSTNM)=""
End DoDot:3
+12 IF '$TEST
Begin DoDot:3
+13 IF ORCLIN=ORPRVCLN
Begin DoDot:4
+14 IF ORDLM>=ORPRVDLM
DO EN^XPAR("LOC."_ORCLNNM,"ORQQPL SELECTION LIST",1,ORLSTNM,.ORERR)
End DoDot:4
+15 IF '$TEST
DO EN^XPAR("LOC."_ORCLNNM,"ORQQPL SELECTION LIST",1,ORLSTNM,.ORERR)
End DoDot:3
+16 IF ORCLIN'=ORPRVCLN
SET ORPRVCLN=ORCLIN
+17 IF ORDLM'=ORPRVDLM
SET ORPRVDLM=ORDLM
+18 SET ORENTY="LOC^"_ORCLNNM
+19 IF +$GET(ORERR)>0
DO PRNTERR(ORERR,ORACT,ORENTY,ORLSTNM)
KILL ORERR
End DoDot:2
End DoDot:1
+20 IF $DATA(ORINVLST)
DO PRNTIERR(.ORINVLST)
+21 QUIT
+22 ;
SETSYSPR ; Set system & package level of ORQQPL SELECTION LIST param to VA National list
+1 NEW ORLSTNM,ORSYSERR,ORPKGERR,ORACT,ORSENTY,ORPENTY
+2 SET ORLSTNM=""
SET ORACT="Setting"
+3 SET ORSENTY="SYS^"
SET ORPENTY="PKG^ORDER ENTRY/RESULTS REPORTING"
+4 FOR
SET ORLSTNM=$ORDER(^GMPL(125,"B",ORLSTNM))
if ORLSTNM=""
QUIT
Begin DoDot:1
+5 IF $EXTRACT(ORLSTNM,1,3)="VA-"
Begin DoDot:2
+6 DO EN^XPAR("SYS","ORQQPL SELECTION LIST",1,ORLSTNM,.ORSYSERR)
+7 DO EN^XPAR("PKG","ORQQPL SELECTION LIST",1,ORLSTNM,.ORPKGERR)
+8 IF +$GET(ORSYSERR)>0
DO PRNTERR(ORSYSERR,ORACT,ORSENTY,ORLSTNM)
+9 IF +$GET(ORPKGERR)>0
DO PRNTERR(ORPKGERR,ORACT,ORPENTY,ORLSTNM)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
SETUSRLT ; Migrate pre-existing user default list to ORQQPL SELECTION LIST param
+1 NEW ORDUZ,ORLST,ORLSTNM,ORUSR,ORERR,ORINVLST,ORENTY,ORACT
+2 SET (ORUSR,ORDUZ)=""
SET ORACT="Migration"
+3 FOR
SET ORUSR=$ORDER(^VA(200,"B",ORUSR))
if ORUSR=""
QUIT
Begin DoDot:1
+4 FOR
SET ORDUZ=$ORDER(^VA(200,"B",ORUSR,ORDUZ))
if ORDUZ=""
QUIT
Begin DoDot:2
+5 SET ORLST=$$GET1^DIQ(200,ORDUZ,125.1,"I")
+6 if 'ORLST
QUIT
+7 SET ORLSTNM=$$GET1^DIQ(125,ORLST,.01)
+8 IF ($LENGTH(ORLSTNM)>0)
Begin DoDot:3
+9 IF '$$VALLIST^GMPLBLD2(ORLST)
Begin DoDot:4
+10 if $$DUPLIST(.ORINVLST,ORLSTNM)
QUIT
+11 SET ORINVLST(ORLSTNM)=""
End DoDot:4
+12 IF '$TEST
DO ADD^XPAR(ORDUZ_";VA(200,","ORQQPL SELECTION LIST",1,ORLSTNM,.ORERR)
End DoDot:3
+13 SET ORENTY="USR^"_ORUSR
+14 IF +$GET(ORERR)>0
DO PRNTERR(ORERR,ORACT,ORENTY,ORLSTNM)
KILL ORERR
End DoDot:2
End DoDot:1
+15 IF $DATA(ORINVLST)
DO PRNTIERR(.ORINVLST)
+16 QUIT
+17 ;
