APCLXXAA ; IHS/OHPRD/TMJ -CREATED BY ^XBERTN ON APR 18, 1996 ;
;;3.0;IHS PCC REPORTS;;FEB 05, 1997
;;ATXSTX ; IHS/OHPRD/TMJ - SEND TAXONOMY WITH PACKAGE ;
;; ;;5.1T1;TAXONOMY SYSTEM;;APR 18, 1996
;; ;
;; ; This routine builds a post-init routine for a specified package.
;; ; The post-init routine will add entries to the TAXONOMY file for
;; ; that package.
;; ;
;; ; To change the size of the generated routines change the numeric
;; ; compare value in PGMTMP2. Originally set at 6000.
;; ;
;;START ;
;; D MAIN
;; D EOJ
;; Q
;; ;
;;MAIN ;
;; D INIT
;; Q:ATXQ
;; F D GENRTN Q:ATXQ
;; D POSTINIT ; update post-init in package file
;; Q
;; ;
;;GENRTN ; GENERATE ROUTINE TO INSTALL TAXONOMY
;; K ^TMP($J),^TMP("ATX",$J)
;; D TAXONOMY ; get taxonomy to export
;; Q:ATXQ
;; D PGMNAME ; get program name
;; Q:ATXQ
;; D TXCHECK ; check taxonomy
;; Q:ATXQ
;; D TXSTORE ; store taxonomy
;; D BUILD ; build and save routines
;; D DRIVER ; build and save main driver
;; Q
;; ;
;;INIT ;
;; D ^XBKVAR
;; S ATXQ=1
;; W !!,"This routine will build a post-init routine for the specified package."
;; W !,"The post-init routine will add the selected entry to the TAXONOMY file"
;; W !,"on the target machine.",!!
;; D PACKAGE ; get package
;; Q:ATXQ
;; S ATXQ=1
;; ; get agency/site/programmer
;; W !
;; S DIR(0)="F^7:15",DIR("A")="Enter agency/site/programmer for routine first line",DIR("?")="E.g., IHS/OHPRD/EDE" K DA D ^DIR K DIR
;; Q:$D(DIRUT)
;; S ATXASP=X
;; W !!,"The name of the primary routine to be generated will be the package prefix"
;; W !,"followed by TX. For each taxonomy being sent there will be one routine with"
;; W !,"the same name followed by a letter A-Z. For large taxonomies there will be"
;; W !,"additional routines with the same letter A-Z followed by a letter A-Z.",!
;; S ATXQ=0
;; Q
;; ;
;;PACKAGE ; GET PACKAGE
;; S ATXQ=1
;; S DIC="^DIC(9.4,",DIC(0)="AEMQ"
;; D ^DIC
;; K D,DD,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DIPGM,DLAYGO,DO,DQ,DR,DINUM
;; Q:Y<0
;; S ATXPK=+Y
;; S ATXPRFX=$P(^DIC(9.4,ATXPK,0),U,2)
;; S ATXQ=0
;; Q
;; ;
;;PGMNAME ; GET PROGRAM NAME
;; S ATXQ=1
;; S ATXPGM=ATXPRFX_"TX",ATXDRVR=ATXPGM
;; F ATXI=1:1:27 S X=ATXPGM_$C(64+ATXI) X ^%ZOSF("TEST") Q:'$T
;; I ATXI=27 W !,ATXPGM_"A-Z already exist. Cannot continue.",!! Q
;; S (ATXPGM,ATXPGMR)=X
;; W !!,"Generating new routine ^"_ATXPGM
;; S X=ATXDRVR X ^%ZOSF("TEST")
;; I $T W !,"Updating existing routine ^"_ATXDRVR,! I 1
;; E W !,"Generating new routine ^"_ATXDRVR,!
;; S ATXQ=0
;; Q
;; ;
;;TAXONOMY ; GET TAXONOMY
;; S ATXQ=1
;; S DIC="^ATXAX(",DIC(0)="AEMQZ"
;; D ^DIC
;; K D,DD,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DIPGM,DLAYGO,DO,DQ,DR,DINUM
;; Q:Y<0
;; S ATXTX=+Y
;; S ATXTXNM=Y(0,0)
;; S ATXQ=0
;; Q
;; ;
;;TXCHECK ; CHECK TAXONOMY
;; W !,"Checking taxonomy "
;; S ATXQ=0
;; S ATXY=0
;; F ATX21C=0:1 S ATXY=$O(^ATXAX(ATXTX,21,ATXY)) Q:'ATXY D
;; . S X=$P(^ATXAX(ATXTX,21,ATXY,0),U)
;; . S:$E(X,$L(X))'=" " X=X_" "
;; . I $D(^TMP("ATX",$J,21,X)) W !!,"Duplicate code entry for code="_X,! S ATXQ=1 Q
;; . S ^TMP("ATX",$J,21,X)=ATXY
;; . Q
;; Q:ATXQ
;; S ATXQ=1
;; S ATXAAC=0
;; S ATXX=""
;; F ATXAAC=0:1 S ATXX=$O(^ATXAX(ATXTX,21,"AA",ATXX)) Q:ATXX=""
;; S ATXX=""
;; F ATXBC=0:1 S ATXX=$O(^ATXAX(ATXTX,21,"B",ATXX)) Q:ATXX=""
;; I 'ATX21C W !!,"No codes in taxonomy",! Q
;; I ATXBC'=ATX21C W !!,"B xref is not correct. B count=",ATXBC," Entry count=",ATX21C,! Q
;; I ATXAAC,ATXAAC'=ATX21C W !!,"AA xref is not correct. AA count=",ATXAAC," Entry count=",ATX21C,! Q
;; S ATXQ=0
;; Q
;; ;
;;TXSTORE ; STORE TAXONOMY IN ^TMP
;; W !,"Storing taxonomy "
;; K ^TMP("DIERR",$J)
;; F ATXF=.01,.02,.04,.06,.08,.09,.11,.12,.13,.14,.15,.16,.17,3101 D
;; . S ATXX=$$VALI^XBDIQ1(9002226,ATXTX,ATXF)
;; . Q:ATXX=""
;; . S ^TMP("ATX",$J,9002226,ATXTX,ATXF)=ATXX
;; . Q
;; S ATXCODE=""
;; F S ATXCODE=$O(^TMP("ATX",$J,21,ATXCODE)) Q:ATXCODE="" D
;; . S ATXY=^TMP("ATX",$J,21,ATXCODE)
;; . S ATXIENS=ATXTX_","_ATXY
;; . S ATXSBSC=ATXTX_","_ATXCODE
;; . W "."
;; . F ATXF=.01,.02 D
;; .. S ATXX=$$VALI^XBDIQ1(9002226.02101,ATXIENS,ATXF)
;; .. Q:ATXX=""
;; .. S ^TMP("ATX",$J,9002226.02101,ATXSBSC,ATXF)=ATXX
;; .. Q
;; . Q
;; S ATXBULL=$$VALI^XBDIQ1(9002226,ATXTX,.07)
;; D:ATXBULL BULSTORE
;; Q
;; ;
;;BULSTORE ; STORE BULLETIN
;; W !,"Storing bulletin "
;; F ATXF=.01,2 D
;; . S ATXX=$$VALI^XBDIQ1(3.6,ATXBULL,ATXF)
;; . Q:ATXX=""
;; . S ^TMP("ATX",$J,3.6,ATXBULL,ATXF)=ATXX
;; . Q
;; S ATXY=0
;; F S ATXY=$O(^XMB(3.6,ATXBULL,4,ATXY)) Q:'ATXY D
;; . S ATXIENS=ATXBULL_","_ATXY
;; . W "."
;; . S ATXX=$$VALI^XBDIQ1(3.64,ATXIENS,.01)
;; . Q:ATXX=""
;; . S ^TMP("ATX",$J,3.64,ATXIENS,.01)=ATXX
;; . Q:'$O(^XMB(3.6,ATXBULL,4,ATXY,1,0))
;; . S ^TMP("ATX",$J,3.64,ATXIENS,1,0)=^XMB(3.6,ATXBULL,4,ATXY,1,0)
;; . S ATXZ=0
;; . F S ATXZ=$O(^XMB(3.6,ATXBULL,4,ATXY,1,ATXZ)) Q:'ATXZ S ^TMP("ATX",$J,3.64,ATXIENS,1,ATXZ,0)=^(ATXZ,0)
;; . Q
;; I $O(^XMB(3.6,ATXBULL,3,0)) D
;; . S ^TMP("ATX",$J,3.63,ATXBULL,3,0)=^XMB(3.6,ATXBULL,3,0)
;; . S ATXY=0
;; . F S ATXY=$O(^XMB(3.6,ATXBULL,3,ATXY)) Q:'ATXY S ^TMP("ATX",$J,3.63,ATXBULL,3,ATXY,0)=^(ATXY,0)
;; . Q
;; I $O(^XMB(3.6,ATXBULL,1,0)) D
;; . S ^TMP("ATX",$J,3.63,ATXBULL,1,0)=^XMB(3.6,ATXBULL,1,0)
;; . S ATXY=0
;; . F S ATXY=$O(^XMB(3.6,ATXBULL,1,ATXY)) Q:'ATXY S ^TMP("ATX",$J,3.63,ATXBULL,1,ATXY,0)=^(ATXY,0)
;; . Q
;; Q
;; ;
;;BUILD ;
;; W !,"Generating routines",!!
;; S Y=DT
;; D DD^%DT
;; S ATXVER=$S($D(^DIC(9.4,ATXPK,"VERSION")):^("VERSION"),1:"")_";"_$P(^DIC(9.4,ATXPK,0),U,1)_";;"_Y
;; K ^TMP("ATXPGM",$J)
;; S ATXPGMC=1
;; K ATXPGMS
;; D PGMBEG ; build main routine
;; S ATXZR=0
;; F S ATXZR=$O(^TMP("ATX",ATXZR)) Q:ATXZR=$J
;; S ATXZR="^TMP(""ATX"","_ATXZR_")"
;; D PGMTMP ; build TMP for $T
;; S X=" ;" D SETTMP
;; S X="OTHER ; OTHER ROUTINES" D SETTMP
;; S ATXX=""
;; F S ATXX=$O(ATXPGMS(ATXX)) Q:ATXX="" S X=" D ^"_ATXX D SETTMP
;; S X=" Q" D SETTMP
;; D PGMSAVE ; save generated program
;; Q
;; ;
;;PGMBEG ; BUILD BEGINNING OF PROGRAM
;; K ^TMP("ATXPGM",$J,ATXPGM)
;; S (ATXL,ATXLNTH)=0
;; S X=ATXPGM_" ;"_ATXASP_"-CREATED BY ^ATXSTX ON "_Y_";" D SETTMP
;; S X=" ;;"_ATXVER D SETTMP
;; I ATXPGMC=1 D
;; . S X=" ;;"_ATXTXNM D SETTMP
;; . S X=" ;" D SETTMP
;; . S X=" ; This routine loads Taxonomy "_ATXTXNM D SETTMP
;; . Q
;; F ATXI=1:1:5 S X=$P($T(CODE+ATXI),";;",2,99) Q:X="" D SETTMP
;; I ATXPGMC=1 F ATXI=6:1:10 S X=$P($T(CODE+ATXI),";;",2,99) Q:X="" D SETTMP
;; I ATXPGMC>1 S X=" Q" D SETTMP
;; Q
;; ;
;;PGMTMP ; BUILD TMP DATA FOR $T ***(CALLED RECURSIVELY)***
;; S ATXTMPQ=0
;; S X=" ;" D SETTMP
;; S X="TMP ;;TAXONOMY (WITH BULLETIN)" D SETTMP
;; F S ATXZR=$Q(@ATXZR) Q:$P(ATXZR,",")'="^TMP(""ATX""" D PGMTMP2 Q:ATXTMPQ
;; Q
;; ;
;;PGMTMP2 ;
;; S X=" ;;"_$P(ATXZR,$J_",",2,99) D SETTMP
;; S X=" ;;"_@ATXZR D SETTMP
;; I ATXLNTH>6000 D RECURSE S ATXTMPQ=1 Q
;; Q
;; ;
;;PGMSAVE ; SAVE GENERATED PROGRAM
;; S XCN=0,DIE="^TMP(""ATXPGM"","_$J_","""_ATXPGM_""",",X=ATXPGM
;; X ^%ZOSF("SAVE")
;; K DIE,XCM,XCN
;; S X=ATXPGM
;; X ^%ZOSF("TEST")
;; I $T W "Routine ^",ATXPGM," has been filed.",! I 1
APCLXXAA ; IHS/OHPRD/TMJ -CREATED BY ^XBERTN ON APR 18, 1996 ;
+1 ;;3.0;IHS PCC REPORTS;;FEB 05, 1997
+2 ;;ATXSTX ; IHS/OHPRD/TMJ - SEND TAXONOMY WITH PACKAGE ;
+3 ;; ;;5.1T1;TAXONOMY SYSTEM;;APR 18, 1996
+4 ;; ;
+5 ;; ; This routine builds a post-init routine for a specified package.
+6 ;; ; The post-init routine will add entries to the TAXONOMY file for
+7 ;; ; that package.
+8 ;; ;
+9 ;; ; To change the size of the generated routines change the numeric
+10 ;; ; compare value in PGMTMP2. Originally set at 6000.
+11 ;; ;
+12 ;;START ;
+13 ;; D MAIN
+14 ;; D EOJ
+15 ;; Q
+16 ;; ;
+17 ;;MAIN ;
+18 ;; D INIT
+19 ;; Q:ATXQ
+20 ;; F D GENRTN Q:ATXQ
+21 ;; D POSTINIT ; update post-init in package file
+22 ;; Q
+23 ;; ;
+24 ;;GENRTN ; GENERATE ROUTINE TO INSTALL TAXONOMY
+25 ;; K ^TMP($J),^TMP("ATX",$J)
+26 ;; D TAXONOMY ; get taxonomy to export
+27 ;; Q:ATXQ
+28 ;; D PGMNAME ; get program name
+29 ;; Q:ATXQ
+30 ;; D TXCHECK ; check taxonomy
+31 ;; Q:ATXQ
+32 ;; D TXSTORE ; store taxonomy
+33 ;; D BUILD ; build and save routines
+34 ;; D DRIVER ; build and save main driver
+35 ;; Q
+36 ;; ;
+37 ;;INIT ;
+38 ;; D ^XBKVAR
+39 ;; S ATXQ=1
+40 ;; W !!,"This routine will build a post-init routine for the specified package."
+41 ;; W !,"The post-init routine will add the selected entry to the TAXONOMY file"
+42 ;; W !,"on the target machine.",!!
+43 ;; D PACKAGE ; get package
+44 ;; Q:ATXQ
+45 ;; S ATXQ=1
+46 ;; ; get agency/site/programmer
+47 ;; W !
+48 ;; S DIR(0)="F^7:15",DIR("A")="Enter agency/site/programmer for routine first line",DIR("?")="E.g., IHS/OHPRD/EDE" K DA D ^DIR K DIR
+49 ;; Q:$D(DIRUT)
+50 ;; S ATXASP=X
+51 ;; W !!,"The name of the primary routine to be generated will be the package prefix"
+52 ;; W !,"followed by TX. For each taxonomy being sent there will be one routine with"
+53 ;; W !,"the same name followed by a letter A-Z. For large taxonomies there will be"
+54 ;; W !,"additional routines with the same letter A-Z followed by a letter A-Z.",!
+55 ;; S ATXQ=0
+56 ;; Q
+57 ;; ;
+58 ;;PACKAGE ; GET PACKAGE
+59 ;; S ATXQ=1
+60 ;; S DIC="^DIC(9.4,",DIC(0)="AEMQ"
+61 ;; D ^DIC
+62 ;; K D,DD,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DIPGM,DLAYGO,DO,DQ,DR,DINUM
+63 ;; Q:Y<0
+64 ;; S ATXPK=+Y
+65 ;; S ATXPRFX=$P(^DIC(9.4,ATXPK,0),U,2)
+66 ;; S ATXQ=0
+67 ;; Q
+68 ;; ;
+69 ;;PGMNAME ; GET PROGRAM NAME
+70 ;; S ATXQ=1
+71 ;; S ATXPGM=ATXPRFX_"TX",ATXDRVR=ATXPGM
+72 ;; F ATXI=1:1:27 S X=ATXPGM_$C(64+ATXI) X ^%ZOSF("TEST") Q:'$T
+73 ;; I ATXI=27 W !,ATXPGM_"A-Z already exist. Cannot continue.",!! Q
+74 ;; S (ATXPGM,ATXPGMR)=X
+75 ;; W !!,"Generating new routine ^"_ATXPGM
+76 ;; S X=ATXDRVR X ^%ZOSF("TEST")
+77 ;; I $T W !,"Updating existing routine ^"_ATXDRVR,! I 1
+78 ;; E W !,"Generating new routine ^"_ATXDRVR,!
+79 ;; S ATXQ=0
+80 ;; Q
+81 ;; ;
+82 ;;TAXONOMY ; GET TAXONOMY
+83 ;; S ATXQ=1
+84 ;; S DIC="^ATXAX(",DIC(0)="AEMQZ"
+85 ;; D ^DIC
+86 ;; K D,DD,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DIPGM,DLAYGO,DO,DQ,DR,DINUM
+87 ;; Q:Y<0
+88 ;; S ATXTX=+Y
+89 ;; S ATXTXNM=Y(0,0)
+90 ;; S ATXQ=0
+91 ;; Q
+92 ;; ;
+93 ;;TXCHECK ; CHECK TAXONOMY
+94 ;; W !,"Checking taxonomy "
+95 ;; S ATXQ=0
+96 ;; S ATXY=0
+97 ;; F ATX21C=0:1 S ATXY=$O(^ATXAX(ATXTX,21,ATXY)) Q:'ATXY D
+98 ;; . S X=$P(^ATXAX(ATXTX,21,ATXY,0),U)
+99 ;; . S:$E(X,$L(X))'=" " X=X_" "
+100 ;; . I $D(^TMP("ATX",$J,21,X)) W !!,"Duplicate code entry for code="_X,! S ATXQ=1 Q
+101 ;; . S ^TMP("ATX",$J,21,X)=ATXY
+102 ;; . Q
+103 ;; Q:ATXQ
+104 ;; S ATXQ=1
+105 ;; S ATXAAC=0
+106 ;; S ATXX=""
+107 ;; F ATXAAC=0:1 S ATXX=$O(^ATXAX(ATXTX,21,"AA",ATXX)) Q:ATXX=""
+108 ;; S ATXX=""
+109 ;; F ATXBC=0:1 S ATXX=$O(^ATXAX(ATXTX,21,"B",ATXX)) Q:ATXX=""
+110 ;; I 'ATX21C W !!,"No codes in taxonomy",! Q
+111 ;; I ATXBC'=ATX21C W !!,"B xref is not correct. B count=",ATXBC," Entry count=",ATX21C,! Q
+112 ;; I ATXAAC,ATXAAC'=ATX21C W !!,"AA xref is not correct. AA count=",ATXAAC," Entry count=",ATX21C,! Q
+113 ;; S ATXQ=0
+114 ;; Q
+115 ;; ;
+116 ;;TXSTORE ; STORE TAXONOMY IN ^TMP
+117 ;; W !,"Storing taxonomy "
+118 ;; K ^TMP("DIERR",$J)
+119 ;; F ATXF=.01,.02,.04,.06,.08,.09,.11,.12,.13,.14,.15,.16,.17,3101 D
+120 ;; . S ATXX=$$VALI^XBDIQ1(9002226,ATXTX,ATXF)
+121 ;; . Q:ATXX=""
+122 ;; . S ^TMP("ATX",$J,9002226,ATXTX,ATXF)=ATXX
+123 ;; . Q
+124 ;; S ATXCODE=""
+125 ;; F S ATXCODE=$O(^TMP("ATX",$J,21,ATXCODE)) Q:ATXCODE="" D
+126 ;; . S ATXY=^TMP("ATX",$J,21,ATXCODE)
+127 ;; . S ATXIENS=ATXTX_","_ATXY
+128 ;; . S ATXSBSC=ATXTX_","_ATXCODE
+129 ;; . W "."
+130 ;; . F ATXF=.01,.02 D
+131 ;; .. S ATXX=$$VALI^XBDIQ1(9002226.02101,ATXIENS,ATXF)
+132 ;; .. Q:ATXX=""
+133 ;; .. S ^TMP("ATX",$J,9002226.02101,ATXSBSC,ATXF)=ATXX
+134 ;; .. Q
+135 ;; . Q
+136 ;; S ATXBULL=$$VALI^XBDIQ1(9002226,ATXTX,.07)
+137 ;; D:ATXBULL BULSTORE
+138 ;; Q
+139 ;; ;
+140 ;;BULSTORE ; STORE BULLETIN
+141 ;; W !,"Storing bulletin "
+142 ;; F ATXF=.01,2 D
+143 ;; . S ATXX=$$VALI^XBDIQ1(3.6,ATXBULL,ATXF)
+144 ;; . Q:ATXX=""
+145 ;; . S ^TMP("ATX",$J,3.6,ATXBULL,ATXF)=ATXX
+146 ;; . Q
+147 ;; S ATXY=0
+148 ;; F S ATXY=$O(^XMB(3.6,ATXBULL,4,ATXY)) Q:'ATXY D
+149 ;; . S ATXIENS=ATXBULL_","_ATXY
+150 ;; . W "."
+151 ;; . S ATXX=$$VALI^XBDIQ1(3.64,ATXIENS,.01)
+152 ;; . Q:ATXX=""
+153 ;; . S ^TMP("ATX",$J,3.64,ATXIENS,.01)=ATXX
+154 ;; . Q:'$O(^XMB(3.6,ATXBULL,4,ATXY,1,0))
+155 ;; . S ^TMP("ATX",$J,3.64,ATXIENS,1,0)=^XMB(3.6,ATXBULL,4,ATXY,1,0)
+156 ;; . S ATXZ=0
+157 ;; . F S ATXZ=$O(^XMB(3.6,ATXBULL,4,ATXY,1,ATXZ)) Q:'ATXZ S ^TMP("ATX",$J,3.64,ATXIENS,1,ATXZ,0)=^(ATXZ,0)
+158 ;; . Q
+159 ;; I $O(^XMB(3.6,ATXBULL,3,0)) D
+160 ;; . S ^TMP("ATX",$J,3.63,ATXBULL,3,0)=^XMB(3.6,ATXBULL,3,0)
+161 ;; . S ATXY=0
+162 ;; . F S ATXY=$O(^XMB(3.6,ATXBULL,3,ATXY)) Q:'ATXY S ^TMP("ATX",$J,3.63,ATXBULL,3,ATXY,0)=^(ATXY,0)
+163 ;; . Q
+164 ;; I $O(^XMB(3.6,ATXBULL,1,0)) D
+165 ;; . S ^TMP("ATX",$J,3.63,ATXBULL,1,0)=^XMB(3.6,ATXBULL,1,0)
+166 ;; . S ATXY=0
+167 ;; . F S ATXY=$O(^XMB(3.6,ATXBULL,1,ATXY)) Q:'ATXY S ^TMP("ATX",$J,3.63,ATXBULL,1,ATXY,0)=^(ATXY,0)
+168 ;; . Q
+169 ;; Q
+170 ;; ;
+171 ;;BUILD ;
+172 ;; W !,"Generating routines",!!
+173 ;; S Y=DT
+174 ;; D DD^%DT
+175 ;; S ATXVER=$S($D(^DIC(9.4,ATXPK,"VERSION")):^("VERSION"),1:"")_";"_$P(^DIC(9.4,ATXPK,0),U,1)_";;"_Y
+176 ;; K ^TMP("ATXPGM",$J)
+177 ;; S ATXPGMC=1
+178 ;; K ATXPGMS
+179 ;; D PGMBEG ; build main routine
+180 ;; S ATXZR=0
+181 ;; F S ATXZR=$O(^TMP("ATX",ATXZR)) Q:ATXZR=$J
+182 ;; S ATXZR="^TMP(""ATX"","_ATXZR_")"
+183 ;; D PGMTMP ; build TMP for $T
+184 ;; S X=" ;" D SETTMP
+185 ;; S X="OTHER ; OTHER ROUTINES" D SETTMP
+186 ;; S ATXX=""
+187 ;; F S ATXX=$O(ATXPGMS(ATXX)) Q:ATXX="" S X=" D ^"_ATXX D SETTMP
+188 ;; S X=" Q" D SETTMP
+189 ;; D PGMSAVE ; save generated program
+190 ;; Q
+191 ;; ;
+192 ;;PGMBEG ; BUILD BEGINNING OF PROGRAM
+193 ;; K ^TMP("ATXPGM",$J,ATXPGM)
+194 ;; S (ATXL,ATXLNTH)=0
+195 ;; S X=ATXPGM_" ;"_ATXASP_"-CREATED BY ^ATXSTX ON "_Y_";" D SETTMP
+196 ;; S X=" ;;"_ATXVER D SETTMP
+197 ;; I ATXPGMC=1 D
+198 ;; . S X=" ;;"_ATXTXNM D SETTMP
+199 ;; . S X=" ;" D SETTMP
+200 ;; . S X=" ; This routine loads Taxonomy "_ATXTXNM D SETTMP
+201 ;; . Q
+202 ;; F ATXI=1:1:5 S X=$P($T(CODE+ATXI),";;",2,99) Q:X="" D SETTMP
+203 ;; I ATXPGMC=1 F ATXI=6:1:10 S X=$P($T(CODE+ATXI),";;",2,99) Q:X="" D SETTMP
+204 ;; I ATXPGMC>1 S X=" Q" D SETTMP
+205 ;; Q
+206 ;; ;
+207 ;;PGMTMP ; BUILD TMP DATA FOR $T ***(CALLED RECURSIVELY)***
+208 ;; S ATXTMPQ=0
+209 ;; S X=" ;" D SETTMP
+210 ;; S X="TMP ;;TAXONOMY (WITH BULLETIN)" D SETTMP
+211 ;; F S ATXZR=$Q(@ATXZR) Q:$P(ATXZR,",")'="^TMP(""ATX""" D PGMTMP2 Q:ATXTMPQ
+212 ;; Q
+213 ;; ;
+214 ;;PGMTMP2 ;
+215 ;; S X=" ;;"_$P(ATXZR,$J_",",2,99) D SETTMP
+216 ;; S X=" ;;"_@ATXZR D SETTMP
+217 ;; I ATXLNTH>6000 D RECURSE S ATXTMPQ=1 Q
+218 ;; Q
+219 ;; ;
+220 ;;PGMSAVE ; SAVE GENERATED PROGRAM
+221 ;; S XCN=0,DIE="^TMP(""ATXPGM"","_$J_","""_ATXPGM_""",",X=ATXPGM
+222 ;; X ^%ZOSF("SAVE")
+223 ;; K DIE,XCM,XCN
+224 ;; S X=ATXPGM
+225 ;; X ^%ZOSF("TEST")
+226 ;; I $T W "Routine ^",ATXPGM," has been filed.",! I 1
