| 1 | AAQPOST2 ;JFW/FGO - ADD LOCAL PACKAGE ENTRIES [1/14/00 4:01pm]
|
|---|
| 2 | ;;1.4;AHJL VISTA PACKAGE TRACKING;**L01**;JAN 14, 2000
|
|---|
| 3 | ; Use EN entry point.
|
|---|
| 4 | Q
|
|---|
| 5 | ; Loop and create new LOCAL NMSPZ KIDS BUILD entries, where
|
|---|
| 6 | ; NMSP represents the Namespace of existing entries and Z
|
|---|
| 7 | ; denotes that it is a Local Kids Build.
|
|---|
| 8 | ;
|
|---|
| 9 | EN S U="^",L2=0 F K=0:0 S L2=$O(^DIC(9.4,L2)) Q:(+L2'>0) D AAQPR
|
|---|
| 10 | EXIT ;
|
|---|
| 11 | K AAQNAM,AAQPRE,AAQPREZ,AAQPV,L2,D0,DD,K
|
|---|
| 12 | Q
|
|---|
| 13 | AAQPR ;
|
|---|
| 14 | ; AAQNAM is the .01 NAME field
|
|---|
| 15 | ; AAQPREZ is the PREFIX_"Z"
|
|---|
| 16 | ; AAQMAIL is the Mail group for the package.
|
|---|
| 17 | ;
|
|---|
| 18 | N DA,DIC,DIE,DLAYGO,DR,X,Y,K
|
|---|
| 19 | W !!," Reading IEN : ",L2," in Package file."
|
|---|
| 20 | ;
|
|---|
| 21 | ; Add only if PREFIX'="" or '["Z", and CLASS is "I"(National).
|
|---|
| 22 | S AAQPRE=$P($G(^DIC(9.4,L2,0)),U,2)
|
|---|
| 23 | I AAQPRE'="",AAQPRE'["Z",$P($G(^DIC(9.4,L2,7)),U,3)="I" D ADDREC
|
|---|
| 24 | Q
|
|---|
| 25 | ADDREC ;
|
|---|
| 26 | ; Since Class is National at this point, if NAME["PATCH"
|
|---|
| 27 | ; or NAME["*" it is the name of a Patch(not a Package), so
|
|---|
| 28 | ; set the Class to "II"(Inactive). Since it is not the primary
|
|---|
| 29 | ; entry in the file for the package, bypass the ADDREC process.
|
|---|
| 30 | ;
|
|---|
| 31 | I $P($G(^DIC(9.4,L2,0)),U,1)["PATCH"!($P($G(^DIC(9.4,L2,0)),U,1)["*") S $P(^DIC(9.4,L2,7),U,3)="II" Q
|
|---|
| 32 | ;
|
|---|
| 33 | ; Process to Add an entry to the Package file
|
|---|
| 34 | ;
|
|---|
| 35 | S AAQPREZ=$P(AAQPRE,",",1)_"Z"
|
|---|
| 36 | S AAQNAM="LOCAL "_AAQPREZ_" KIDS BUILDS"
|
|---|
| 37 | W !," Checking for existing entry for : ",AAQNAM
|
|---|
| 38 | S X=AAQNAM,DIC="^DIC(9.4,",DIC(0)="XM" D ^DIC I +Y>0 S AAQPV=+Y
|
|---|
| 39 | I $D(^DIC(9.4,"B",AAQNAM)) W !," Entry already exits, NOT ADDED" Q
|
|---|
| 40 | ; Add new entry if B x-ref does not exist.
|
|---|
| 41 | I '$D(^DIC(9.4,"B",AAQNAM)) D
|
|---|
| 42 | .S X=AAQNAM,DIC="^DIC(9.4," S DIC(0)="ML" D FILE^DICN
|
|---|
| 43 | .S AAQPV=+Y
|
|---|
| 44 | .I AAQPV'="" D
|
|---|
| 45 | ..S $P(^DIC(9.4,AAQPV,0),U,2)=AAQPREZ
|
|---|
| 46 | ..S $P(^DIC(9.4,AAQPV,0),U,3)="Local "_AAQPREZ_" KIDS Builds"
|
|---|
| 47 | ..S ^DIC(9.4,AAQPV,1,0)="^^3^3^3000114^^"
|
|---|
| 48 | ..S ^DIC(9.4,AAQPV,1,1,0)=" "
|
|---|
| 49 | ..S ^DIC(9.4,AAQPV,1,2,0)=" 01-14-2000/JFW - Used for VISN 13 "_AAQNAM_"."
|
|---|
| 50 | ..S ^DIC(9.4,AAQPV,1,3,0)=" - Entry added by EN^AAQPOST2 routine."
|
|---|
| 51 | ..S ^DIC(9.4,AAQPV,7)="^^III"
|
|---|
| 52 | ..S ^DIC(9.4,AAQPV,"MG")=$G(^DIC(9.4,L2,"MG"))
|
|---|
| 53 | ..S ^DIC(9.4,AAQPV,"VERSION")=$G(^DIC(9.4,L2,"VERSION"))
|
|---|
| 54 | ..W !," ** Entry has been added **"
|
|---|
| 55 | Q
|
|---|
