FSCRPCGT ;SLC/STAFF-NOIS RPC Test Package Installs ;1/11/98  15:25
 ;;1.1;NOIS;;Sep 06, 1998
 ;
SITE(SITE) ; from FSCRPCG
 N CNT,DATE,LINE,LINE1,NUM,OK,PACK,PACKNM,SITENUM,VER K ^TMP("FSC TEST",$J)
 S SITENUM=+$$STSITE^FSCRPCOC(+$G(SITE)) I 'SITENUM Q
 S CNT=0
 S NUM=0 F  S NUM=$O(^NTS(2050,SITENUM,8,NUM)) Q:NUM<1  S LINE=$G(^(NUM,0)) D
 .S PACK=$$STPACK(NUM) I 'PACK Q
 .S VER=$P(LINE,U,7)
 .S OK=0
 .I VER["T" S OK=1
 .I VER["V" S OK=1
 .I 'OK Q
 .S DATE=$P(LINE,U,8),DATE=$$FMTE^XLFDT(DATE)
 .S PACKNM=$P(^FSC("PACK",PACK,0),U)
 .S LINE1=$$SETSTR^VALM1(VER,PACKNM,30,$L(VER))
 .S LINE1=$$SETSTR^VALM1(DATE,LINE1,37,$L(DATE))
 .S CNT=CNT+1,^TMP("FSC TEST",$J,PACKNM,CNT)=LINE1
 I 'CNT S ^TMP("FSCRPC",$J,"OUTPUT",1)="   No test versions of packages installed." Q
 S CNT=0,PACKNM="" F  S PACKNM=$O(^TMP("FSC TEST",$J,PACKNM)) Q:PACKNM=""  D
 .S NUM=0 F  S NUM=$O(^TMP("FSC TEST",$J,PACKNM,NUM)) Q:NUM<1  S LINE=^(NUM) D
 ..S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
 K ^TMP("FSC TEST",$J)
 Q
 ;
MOD(MODULE) ; from  FSCRPCG
 N CNT,DATE,LINE,NUM,OK,PACKAGE,SITENM,SITENUM,VER K ^TMP("FSC TEST",$J)
 S PACKAGE=+$P($G(^FSC("MOD",+$G(MODULE),0)),U,8) I 'PACKAGE Q
 S PACKAGE=$$STPACK^FSCRPCGN(PACKAGE) I 'PACKAGE Q
 S CNT=0
 S SITENUM=0 F  S SITENUM=$O(^NTS(2050,SITENUM)) Q:SITENUM<1  D
 .S LINE=$G(^NTS(2050,SITENUM,8,PACKAGE,0)) I '$L(LINE) Q
 .S VER=$P(LINE,U,7)
 .S OK=0
 .I VER["T" S OK=1
 .I VER["V" S OK=1
 .I 'OK Q
 .S DATE=$P(LINE,U,8),DATE=$$FMTE^XLFDT(DATE)
 .S SITENM=$$STSITE(SITENUM) I 'SITENM Q
 .S SITENM=$P($G(^FSC("SITE",SITENM,0)),U) I '$L(SITENM) Q
 .S LINE=$$SETSTR^VALM1(VER,SITENM,30,$L(VER))
 .S LINE=$$SETSTR^VALM1(DATE,LINE,37,$L(DATE))
 .S CNT=CNT+1,^TMP("FSC TEST",$J,SITENM,CNT)=LINE
 I 'CNT S ^TMP("FSCRPC",$J,"OUTPUT",1)="   No sites with test versions installed." Q
 S CNT=0,SITENM="" F  S SITENM=$O(^TMP("FSC TEST",$J,SITENM)) Q:SITENM=""  D
 .S NUM=0 F  S NUM=$O(^TMP("FSC TEST",$J,SITENM,NUM)) Q:NUM<1  S LINE=^(NUM) D
 ..S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
 K ^TMP("FSC TEST",$J)
 Q
 ;
STPACK(STPACK) ; $$(site tracking package) -> site
 N OPACK,PACK
 S OPACK=+$P($G(^DIC(120102,+$G(STPACK),0)),U,8) I 'STPACK Q ""
 S PACK=+$O(^FSC("PACK","AC",OPACK,0)) I 'PACK Q ""
 Q PACK
 ;
STSITE(STSITE) ; $$(site tracking site) -> site
 N DOMAIN,SITE
 S DOMAIN=$P($G(^NTS(2050,+$G(STSITE),22)),U) I '$L(DOMAIN) Q ""
 S DOMAIN=+$O(^DIC(4.2,"B",DOMAIN,0)) I 'DOMAIN Q ""
 S SITE=+$O(^FSC("SITE","AE",DOMAIN,0)) I 'SITE Q ""
 Q SITE
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCGT   2535     printed  Sep 23, 2025@19:55:46                                                                                                                                                                                                    Page 2
FSCRPCGT  ;SLC/STAFF-NOIS RPC Test Package Installs ;1/11/98  15:25
 +1       ;;1.1;NOIS;;Sep 06, 1998
 +2       ;
SITE(SITE) ; from FSCRPCG
 +1        NEW CNT,DATE,LINE,LINE1,NUM,OK,PACK,PACKNM,SITENUM,VER
           KILL ^TMP("FSC TEST",$JOB)
 +2        SET SITENUM=+$$STSITE^FSCRPCOC(+$GET(SITE))
           IF 'SITENUM
               QUIT 
 +3        SET CNT=0
 +4        SET NUM=0
           FOR 
               SET NUM=$ORDER(^NTS(2050,SITENUM,8,NUM))
               if NUM<1
                   QUIT 
               SET LINE=$GET(^(NUM,0))
               Begin DoDot:1
 +5                SET PACK=$$STPACK(NUM)
                   IF 'PACK
                       QUIT 
 +6                SET VER=$PIECE(LINE,U,7)
 +7                SET OK=0
 +8                IF VER["T"
                       SET OK=1
 +9                IF VER["V"
                       SET OK=1
 +10               IF 'OK
                       QUIT 
 +11               SET DATE=$PIECE(LINE,U,8)
                   SET DATE=$$FMTE^XLFDT(DATE)
 +12               SET PACKNM=$PIECE(^FSC("PACK",PACK,0),U)
 +13               SET LINE1=$$SETSTR^VALM1(VER,PACKNM,30,$LENGTH(VER))
 +14               SET LINE1=$$SETSTR^VALM1(DATE,LINE1,37,$LENGTH(DATE))
 +15               SET CNT=CNT+1
                   SET ^TMP("FSC TEST",$JOB,PACKNM,CNT)=LINE1
               End DoDot:1
 +16       IF 'CNT
               SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="   No test versions of packages installed."
               QUIT 
 +17       SET CNT=0
           SET PACKNM=""
           FOR 
               SET PACKNM=$ORDER(^TMP("FSC TEST",$JOB,PACKNM))
               if PACKNM=""
                   QUIT 
               Begin DoDot:1
 +18               SET NUM=0
                   FOR 
                       SET NUM=$ORDER(^TMP("FSC TEST",$JOB,PACKNM,NUM))
                       if NUM<1
                           QUIT 
                       SET LINE=^(NUM)
                       Begin DoDot:2
 +19                       SET CNT=CNT+1
                           SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
                       End DoDot:2
               End DoDot:1
 +20       KILL ^TMP("FSC TEST",$JOB)
 +21       QUIT 
 +22      ;
MOD(MODULE) ; from  FSCRPCG
 +1        NEW CNT,DATE,LINE,NUM,OK,PACKAGE,SITENM,SITENUM,VER
           KILL ^TMP("FSC TEST",$JOB)
 +2        SET PACKAGE=+$PIECE($GET(^FSC("MOD",+$GET(MODULE),0)),U,8)
           IF 'PACKAGE
               QUIT 
 +3        SET PACKAGE=$$STPACK^FSCRPCGN(PACKAGE)
           IF 'PACKAGE
               QUIT 
 +4        SET CNT=0
 +5        SET SITENUM=0
           FOR 
               SET SITENUM=$ORDER(^NTS(2050,SITENUM))
               if SITENUM<1
                   QUIT 
               Begin DoDot:1
 +6                SET LINE=$GET(^NTS(2050,SITENUM,8,PACKAGE,0))
                   IF '$LENGTH(LINE)
                       QUIT 
 +7                SET VER=$PIECE(LINE,U,7)
 +8                SET OK=0
 +9                IF VER["T"
                       SET OK=1
 +10               IF VER["V"
                       SET OK=1
 +11               IF 'OK
                       QUIT 
 +12               SET DATE=$PIECE(LINE,U,8)
                   SET DATE=$$FMTE^XLFDT(DATE)
 +13               SET SITENM=$$STSITE(SITENUM)
                   IF 'SITENM
                       QUIT 
 +14               SET SITENM=$PIECE($GET(^FSC("SITE",SITENM,0)),U)
                   IF '$LENGTH(SITENM)
                       QUIT 
 +15               SET LINE=$$SETSTR^VALM1(VER,SITENM,30,$LENGTH(VER))
 +16               SET LINE=$$SETSTR^VALM1(DATE,LINE,37,$LENGTH(DATE))
 +17               SET CNT=CNT+1
                   SET ^TMP("FSC TEST",$JOB,SITENM,CNT)=LINE
               End DoDot:1
 +18       IF 'CNT
               SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="   No sites with test versions installed."
               QUIT 
 +19       SET CNT=0
           SET SITENM=""
           FOR 
               SET SITENM=$ORDER(^TMP("FSC TEST",$JOB,SITENM))
               if SITENM=""
                   QUIT 
               Begin DoDot:1
 +20               SET NUM=0
                   FOR 
                       SET NUM=$ORDER(^TMP("FSC TEST",$JOB,SITENM,NUM))
                       if NUM<1
                           QUIT 
                       SET LINE=^(NUM)
                       Begin DoDot:2
 +21                       SET CNT=CNT+1
                           SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
                       End DoDot:2
               End DoDot:1
 +22       KILL ^TMP("FSC TEST",$JOB)
 +23       QUIT 
 +24      ;
STPACK(STPACK) ; $$(site tracking package) -> site
 +1        NEW OPACK,PACK
 +2        SET OPACK=+$PIECE($GET(^DIC(120102,+$GET(STPACK),0)),U,8)
           IF 'STPACK
               QUIT ""
 +3        SET PACK=+$ORDER(^FSC("PACK","AC",OPACK,0))
           IF 'PACK
               QUIT ""
 +4        QUIT PACK
 +5       ;
STSITE(STSITE) ; $$(site tracking site) -> site
 +1        NEW DOMAIN,SITE
 +2        SET DOMAIN=$PIECE($GET(^NTS(2050,+$GET(STSITE),22)),U)
           IF '$LENGTH(DOMAIN)
               QUIT ""
 +3        SET DOMAIN=+$ORDER(^DIC(4.2,"B",DOMAIN,0))
           IF 'DOMAIN
               QUIT ""
 +4        SET SITE=+$ORDER(^FSC("SITE","AE",DOMAIN,0))
           IF 'SITE
               QUIT ""
 +5        QUIT SITE