A1AEFV1 ;VEN/LGC - VEN FUNCTIONS BUILDS AND INSTALLS ; 9/19/14 3:54pm
 ;;2.4;PATCH MODULE;;SEP 11, 2014
 ;
 ; CHANGE LGC - 9/18/2014
 ;    Modified REQB to build double array
 ;    BMARR(BUILD)=IEN into 9.6
 ;    BMARR(n,BUILD)=Depth in descendants
 ;
 ; Return in BMARR array all REQUIRED BUILDS for
 ;  a the BUILD entry in BUILDS [#9.6]
 ; Code by Rick Marshall and Joel Ivey during dev conference call
 ;    discussing recursion practices
 ; ENTER
 ;   BUILD   =  bill name 
 ;   BMARR   =  array passed by reference
 ; EXIT
 ;   BMARR   =  array of names of all REQUIRED BUILDS
REQB(BUILD,BMARR) ;
 S:'$D(BMARR(0)) BMARR(0)=0,BMARR(0,0)=1
 N BIEN S BIEN=$O(^XPD(9.6,"B",BUILD,0)) ; do we have an IEN?
 Q:'BIEN  ; skip if no record
 S BMARR(BUILD)=$O(^XPD(9.6,"B",BUILD,0)) ; add to requirements
 S BMARR(0)=BMARR(0)+1,BMARR(BMARR(0),BUILD)=BMARR(0,0)
 N REQB S REQB=""
 F  S REQB=$O(^XPD(9.6,BIEN,"REQB","B",REQB)) Q:REQB=""  D
 . Q:$D(BMARR(REQB))  ; already have
 . S BMARR(0,0)=BMARR(0,0)+1
 . I $D(DECN) S @XDECN@(0)=$G(@XDECN@(0))+1
 . D REQB(REQB,.BMARR) ; add all its required builds
 S BMARR(0,0)=BMARR(0,0)-1 Q
 ;
 ; Return in BMARR array all MULTIPLE BUILDS for
 ;  a the BUILD entry in BUILDS [#9.6]
 ; ENTER
 ;   BUILD   =  bill name 
 ;   BMARR   =  array passed by reference
 ; EXIT
 ;   BMARR   =  array of names of all Multiple Builds
MULB(BUILD,BMARR) ;
 N BIEN S BIEN=$O(^XPD(9.6,"B",BUILD,0)) ; do we have an IEN?
 Q:'BIEN  ; skip if no record
 S BMARR(BUILD)=$O(^XPD(9.6,"B",BUILD,0)) ; add to requirements
 N MULB S MULB=""
 F  S MULB=$O(^XPD(9.6,BIEN,10,"B",MULB)) Q:MULB=""  D
 . Q:$D(BMARR(MULB))  ; already have
 . D MULB(MULB,.BMARR) ; add all its MULTIPLE builds
 Q
 ;
 ;
 ; Return in BMARR array all REQUIRED or MULTIPLE builds
 ;  a the BUILD entry in BUILDS [#9.6]
 ; ENTER
 ;   BUILD   =  bill name 
 ;   BMARR   =  array passed by reference
 ;   RMB     =  "R" REQUIRED BUILDS, "M" MULTIPLE BUILDS
 ; EXIT
 ;   BMARR   =  array of names of all REQ or MUL
 ;
RMB(BUILD,BMARR,RMB) ;
 K BMARR
 D:RMB="R" REQB(BUILD,.BMARR)
 D:RMB="M" MULB(BUILD,.BMARR)
 Q
 ;
 ;
 ; Compare the existing REQUIRED BUILD [#11] entries 
 ;   to those generated by the REQB function above
 ; VARIABLES
 ;    BCNT      = Number BUILDS found by REQB function
 ;    BIEN      = IEN into 9.6
 ;    BLDERR    = Number of builds with discrepancies between
 ;                entries in REQUIRED BUILD vs found by function
 ;    BLDREN    = Number of builds with REQUIRED BUILD entries
 ;    BLDTOT    = Total build entries in file 9.6
 ;    BNM       = Name of build under review
 ;    BUILD     = Name of a Build in fuction array
 ;    RCNT      = Number of REQUIRED BUILD entries
 ;    REQB      = Name of build in REQUIRED BUILD multiple
 ;    REQBARR   = Array of Required Builds in the entry
 ;
TEST N BIEN,BNM,RCNT,REQB,REQBARR,BCNT,BUILD
 N BLDTOT,BLDREN,BLDERR,X
 S BIEN=0
 F  S BIEN=$O(^XPD(9.6,BIEN)) Q:'BIEN  D
 .  S BLDTOT=$G(BLDTOT)+1
 .  S BNM=$P(^XPD(9.6,BIEN,0),"^")
 .  S RCNT=0 S REQB=""
 .  K REQBARR
 .  F  S REQB=$O(^XPD(9.6,BIEN,"REQB","B",REQB)) Q:REQB=""  D
 ..  S RCNT=RCNT+1
 ..  S REQBARR(REQB)=$O(^XPD(9.6,"B",REQB,0))
 .  I RCNT S BLDREN=$G(BLDREN)+1
 .  K BMARR D REQB(BNM,.BMARR)
 .  K BMARR(BNM) ; Remove the entry representing parent
 .; CHANGE 9/18/2014 BUILD=" " rather than BUILD=""
 .;   to account for modification of REQB to double array
 .  S BCNT=0,BUILD=" "
 .  F  S BUILD=$O(BMARR(BUILD)) Q:BUILD=""  D
 ..  S BCNT=BCNT+1
 .  I RCNT'=BCNT D
 ..  S BLDERR=$G(BLDERR)+1
 ..  W:RCNT !,"BIEN=",BIEN," RCNT=",RCNT," BCNT=",BCNT
 ..  W " ",$P(^XPD(9.6,BIEN,0),"^"),!
 ..  I RCNT,$D(REQBARR) ;W "REQBARR",! ZWR REQBARR W !
 ..  I RCNT,$D(BMARR) ;W "BMARR",! ZWR BMARR W !
 ..;  R X:DTIME
 W !,"BUILDS IN FILE=",BLDTOT
 W !,"BUILDS WITH 1 OR MORE REQUIRED BUILD ENTRIES=",BLDREN
 W !,"BUILDS WITH ENTRY COUNT ERRORS=",BLDERR
 Q
 ;
 ;
 ; Use the REQB function above to find all decendents of the
 ;   present REQUIRED BUILD entries for this parent build
 ;   and push them into the REQUIRED BUILDS [#11] multiple
 ;
A1AEFRQB(BUILD) ; File REQUIRED BUILDS
 Q:BUILD=""
 N BIEN S BIEN=$O(^XPD(9.6,"B",BUILD,0)) Q:'BIEN
 D REQB(BUILD,.BMARR)
 Q:'$D(BMARR)
 ; CHANGE 9/18/2014 BLDNM=" " rather than BLDNM=""
 ;   to account for modification of REQB to double array
 N BLDNM,DIERR S BLDNM=" "
 F  S BLDNM=$O(BMARR(BLDNM)) Q:BLDNM=""  D  Q:$D(DIERR)
 .; Do not enter name of primary build in REQUIRED BUILDS
 .  I BUILD'=BLDNM D
 ..  W !,BLDNM
 ..  N FDA,DIERR
 ..  S FDA(3,9.611,"?+1,"_BIEN_",",.01)=BLDNM
 ..  D UPDATE^DIE("","FDA(3)","")
 I $D(DIERR) W !,"DIERR ERROR"
 Q
 ;
 ;
 ; Use the MULB function above to find all decendents of the
 ;   present MULTIPLE BUILD entries for this parent build
 ;   and push them into the MULTIPLE BUILDS [#10] multiple
 ;
A1AEFMUB(BUILD) ; File MULTIPLE BUILDS
 Q:BUILD=""
 N BIEN S BIEN=$O(^XPD(9.6,"B",BUILD,0)) Q:'BIEN
 D MULB(BUILD,.BMARR)
 Q:'$D(BMARR)
 N BLDNM,DIERR S BLDNM=""
 F  S BLDNM=$O(BMARR(BLDNM)) Q:BLDNM=""  D  Q:$D(DIERR)
 .; Do not enter name of primary build in MULTIPLE BUILDS
 .  I BUILD'=BLDNM D
 ..  W !,BLDNM
 ..  N FDA,DIERR
 ..  S FDA(3,9.63,"?+1,"_BIEN_",",.01)=BLDNM
 ..  D UPDATE^DIE("","FDA(3)","")
 I $D(DIERR) W !,"DIERR ERROR"
 Q
 ;
 ;
 ; Given a routine, trace out all the patches in 11005
 ;  containing that routine
 ; Note: DHCP PATCHES file very incomplete at this time
 ; Note: How handle routines without version or package?
 ; ENTER
 ;   A1AERTNM   =  Routine Name
 ;   PTCHARR    =  Array of Patches required to build
 ;                 second line of routine
 ; VARIABLES
 ;   A1AE005    =  IEN of patch in file 11005
 ;   A1AE2LN    =  Second line of the routine
 ;   A1AEPLST   =  List of patches from routine second line
 ;   A1AESBB    =  Package abbreviation
 ;   A1AESIEN   =  Package IEN in file 9.4
 ;   A1AESNM    =  Package name from second line
 ;   A1AEVR     =  Version from second line
 ;   A1AEPNM    =  Patch Name built from routine second line
 ;
PTC4RTN(A1AERTNM,PTCHARR) ;
 K PTCHARR Q:A1AERTNM=""
 N A1AE2LN S A1AE2LN=$T(+2^@A1AERTNM)
 Q:A1AE2LN=""  ; No second line, bail out.
 W !,A1AE2LN,!
 N A1AEVR S A1AEVR=$P(A1AE2LN,";",3) ; get version
 ; DHCP PATCHES file never uses ".0" version numbering
 I A1AEVR?.NP1"0" S A1AEVR=$P(A1AEVR,".")
 N A1AESNM S A1AESNM=$P(A1AE2LN,";",4) ; get package name
 ; Convert package name to package abbreviation
 N A1AESIEN S A1AESIEN=$O(^DIC(9.4,"B",A1AESNM,0))
 N A1AESABB S A1AESABB=$$GET1^DIQ(9.4,A1AESIEN_",",1)
 ; Get listing of patches from routines second line
 N A1AEPLST S A1AEPLST=$P(A1AE2LN,"**",2)
 N CNT,A1AEPNM
 ; Look for patches required to build second line
 ; Save necessary patches in array with IEN of patch
 ;   in file 11005 if found
 F CNT=1:1:$L(A1AEPLST,",") D
 . S A1AEPNM=A1AESABB_"*"_A1AEVR_"*"_$P(A1AEPLST,",",CNT)
 . S PTCHARR(A1AEPNM)=""
 . S A1AE005=$O(A1AE(11005,"B",A1AEPNM,0))
 . I A1AE005 W "  DHCP PATCH ENTRY:",A1AE005
 . S PTCHARR(A1AEPNM)=A1AE005
 Q
 ;
 ; Given a patch, trace out all routines and associated
 ;   patches for those routines
 ; Remember the routine second line listed in the patch
 ;   may not be the routines listed in the second line
 ;   of the active routine
 ; Logic
 ;  Identify every routine in a patch 
 ;     ^A1AE(11005,PATCH IEN,"P",SS,0)=ROUTINE^CHKSM^**123,231**
 ;   With each routine idenfity every patch with that routine
 ;       ^A1AE(11005,"R",RTN,11005IEN,SS WITHIN PATCH)
 ;       Run the above
 ;    Get the second line from the active routine
 ;       Run the above
PTCRTNS(A1AEPIEN,PTCHARR) ;
 Q:'$G(A1AEPIEN)
 K PTCHARR
 ; Get routines in the patch
 N A1AER,A1AERR,A1AERRS,A1AERSS S A1AERSS=0
 F  S A1AERSS=$O(^A1AE(11005,A1AEPIEN,"P",A1AERSS)) Q:'A1AERSS  D
 .  S A1AER=^A1AE(11005,A1AEPIEN,"P",A1AERSS,0)
 .  S A1AERTNM=$P(A1AER,"^"),A1AEPLST=$P(A1AER,"^",3)
 .  S PTCHARR(A1AERTNM,"P",A1AEPIEN,A1AERSS)=A1AEPLST
 .  S PTCHARR(A1AERTNM,"ACTIVE")=$T(+2^@A1AERTNM)
 .;  Get routines in other patches
 .  S A1AERR=0
 .  F  S A1AERR=$O(^A1AE(11005,"R",A1AERR)) Q:'A1AERR  D
 ..  S A1AERRS=$O(^A1AE(11005,A1AERR,"P","B",A1AERTNM,0))
 ..  S A1AEPLST=$P(^A1AE(11005,A1AERR,"P",A1AERSS,0),"^",3)
 ..  S PTCHARR(A1AERTNM,"P",A1AERR,A1AERRS)=A1AEPLST
 Q
 ;
 ; Required patch list name in KIDS considering patch stream of
 ;   developer's site
 ; Logic
 ;   1. Get Patch Stream for this developer from 11007.1
 ;   2. Find all REQUIRED BUILDS for this build (BMARR array)
 ;   3. Look up each build in DHCP PATCHES 11005 file
 ;   4. If found, remove array node if Stream wrong
 ;   5. Return list of BUILDS matching developer's Stream
 ; Example
 ;   SD*5.3*70 would have had 5 entries in REQUIRED BUILDS
 ;      and returned a BARR array with 9 as a few more
 ;      were found with the REQB function
 ;      All are VISTA BUILDS.  Unfortunately none are
 ;       in 11005
 ;   However, I added SD*5.3*10504 as an additional REQB
 ;      Now when I run REQB^A1AEFV1 AT PTC4KIDS+3
 ;      I am returned 213 nodes in array as 10504 is
 ;      an OSEHRA build based on SD*5.3*504.  All,except
 ;      one of these SD*5.3*10504 is missing in 11005.
 ;      However, with this logic, they would have been
 ;      deleted anyway as they would be listed as VISTA
 ;      stream (PRIMARY set to 1 for FOIA VISTA
 ;   So, now to test the splitting off of REQUIRED BUILDS
 ;      (and the associated patches in 11005), I will
 ;      remove all BUILD nodes in the original array that do
 ;      not have corresponding OSEHRA patches in 11005
 ;
PTC4KIDS(BUILD,BARR) ;
 ; PTSTRM will be 0,1,or 10001
 N PTSTRM S PTSTRM=$O(^A1AE(11007.1,"APRIM",1,0))
 N BIEN S BIEN=$O(^XPD(9.6,"B",BUILD,0)) Q:'BIEN
 K BARR
 D REQB^A1AEFV1(BUILD,.BARR) ; Get all required builds and decendants
 ; CHANGE 9/18/2014 $NA(BARR) to $NA(BARR(" "))
 ;   to account for modification of REQB to double array
 S NODE=$NA(BARR(" ")) F  S NODE=$Q(@NODE) Q:NODE'["BARR"  D
 . S PD=$QS(NODE,1)
 .; Remove BARR node if = BUILD, or already in Required Builds
 . I (PD=BUILD) K @NODE
 . I $D(^XPD(9.6,BIEN,"REQB","B",PD)) K @NODE
 .; correct for builds with ".0" in version
 . I $P(PD,"*",2)?.NP1"0" D
 .. S PD=$P(PD,"*")_"*"_$P($P(PD,"*",2),".")_"*"_$P(PD,"*",3)
 . S PDIEN=$O(^A1AE(11005,"B",PD,0))
 .; Local change to increase returned list size
 .; I 'PDIEN K @NODE Q
 .; I $$GET1^DIQ(11005,PDIEN_",",.2,"I")'=PTSTRM K @NODE
 Q
 ;
 ;ENTER:
 ;   BUILD   =  Name of parent build in question
 ;EXIT
 ;   BARR    =  Array of REQUIRED BUILDS to add to the
 ;               parent after developer filtered those
 ;               found by PTC4KIDS above
 ;
SELBLDS(BUILD) ;
 N X,Y,DIERR
 D PTC4KIDS(BUILD,.BARR)
 I '$D(BARR) W !,"No additional Required Builds identified.",! Q
 N BIEN S BIEN=$O(^XPD(9.6,"B",BUILD,0)) Q:'BIEN
 N CNT,NODE S NODE=$NA(BARR(" "))
 F  S NODE=$Q(@NODE) Q:NODE'["BARR"  S CNT=$G(CNT)+1
 W !,"Parent Build : ",BUILD
 W !,?5,"REQUIRED BUILDS entries"
 N REQB S REQB=" "
 F  S REQB=$O(^XPD(9.6,BIEN,"REQB","B",REQB)) Q:REQB=""  D
 . W !,?10,REQB
 W !,"Number of Required Build descendants identified = ",CNT,!
 ; Ask developer what they wish to do with the list
 N DIR
 S DIR(0)="SO^1:Ignore;2:Keep;3:Minimum Set"
 S DIR("L",1)="Select one of the following:"
 S DIR("L",2)=""
 S DIR("L",3)="1. Ignore all Required Build descendants"
 S DIR("L",4)="2. Keep all Required Build descendants"
 S DIR("L",5)="3. Reduce Required Build descendants to minimum set"
 D ^DIR
 Q:Y<2
 K DIR
 S DIR(0)="SO^1:Display;2:Update"
 S DIR("L",1)="Select one of the following:"
 S DIR("L",2)=""
 S DIR("L",3)="1. Display the Required Build descendants"
 S DIR("L",4)="2. Update REQUIRED BUILDS multiple of "_BUILD
 D ^DIR
 Q:Y<1
 I Y=1 D
 . N CNT
 . S NODE=$NA(BARR(0))
 . F  S NODE=$Q(@NODE) Q:$QS(NODE,2)=""  D
 .. W ! F CNT=1:1:@NODE W "."
 ..  W $QS(NODE,2)
 Q
 . S NODE=$NA(BARR) S CNT=0 W !
 . F  S NODE=$Q(@NODE) Q:NODE'["BARR"  D
 .. I $L($QS(NODE,1))>14 W !,$QS(NODE,1),! Q
 .. I CNT>4 S CNT=0 W !
 .. W ?CNT*15,$QS(NODE,1)
 .. S CNT=CNT+1
 ;
 Q
 ;
EOR ; end of routine A1AEFV1
