APCLPOS4.m

APCLPOS4 ; IHS/OHPRD/TMJ -CREATED BY ^XBERERTN ON APR 04, 1996 ;

 ;;3.0;IHS PCC REPORTS;;FEB 05, 1997

 ; This routine loads Routine ^ZIBVK

 ;

START ;

 S XBERPGM="ZIBVK"

 F I=1:1 S Y=$P($T(RTN+I),";;",2,99) Q:Y=""  S X="^TMP(""XBERPGM"",$J,"_I_",0)" S @X=Y

 S XCN=0,DIE="^TMP(""XBERPGM"","_$J_",",X=XBERPGM

 X ^%ZOSF("SAVE")

 K DIE,XCM,XCN

 S X=XBERPGM

 X ^%ZOSF("TEST")

 W !

 I $T W "Routine ^",XBERPGM," has been filed.",! I 1

 E  W "Saving of routine ^",XBERPGM," failed.",!

 K ^TMP("XBERPGM",$J)

 K XBERPGM,I,X,Y

 Q

 ;

RTN ; The routine to be loaded follows:

 ;;ZIBVKMSM ; IHS/OHPRD/EDE - KILL VARIABLES [ 09/30/95  11:55 AM ]

 ;; ;

 ;; ; ZL this routine and ZS as ZIBVK

 ;; ;

 ;; ; This routine kills variables that begin with the string entered

 ;; ; by the user.

 ;; ;

 ;; Q  ;        No entry from top

 ;; ;

 ;;EN(ZIBVKNS)        ;EP - KILL VARIABLES IN NAME SPACE

 ;; Q:$G(ZIBVKNS)=""

 ;; NEW ZIBVKX

 ;; S ZIBVKX=$O(@ZIBVKNS,-1)

 ;; S:ZIBVKX="" ZIBVKX="%"

 ;; K:ZIBVKNS="%" @ZIBVKNS

 ;; F  S ZIBVKX=$O(@ZIBVKX) Q:ZIBVKX=""  Q:$E(ZIBVKX,1,$L(ZIBVKNS))]ZIBVKNS  I $E(ZIBVKX,1,$L(ZIBVKNS))=ZIBVKNS,ZIBVKX'["ZIBVK" K @ZIBVKX

 ;; Q

APCLPOS4  ; IHS/OHPRD/TMJ -CREATED BY ^XBERERTN ON APR 04, 1996 ;

 +1       ;;3.0;IHS PCC REPORTS;;FEB 05, 1997

 +2       ; This routine loads Routine ^ZIBVK

 +3       ;

START     ;

 +1        SET XBERPGM="ZIBVK"

 +2        FOR I=1:1

               SET Y=$PIECE($TEXT(RTN+I),";;",2,99)

               IF Y=""

                   QUIT 

               SET X="^TMP(""XBERPGM"",$J,"_I_",0)"

               SET @X=Y

 +3        SET XCN=0

           SET DIE="^TMP(""XBERPGM"","_$JOB_","

           SET X=XBERPGM

 +4        XECUTE ^%ZOSF("SAVE")

 +5        KILL DIE,XCM,XCN

 +6        SET X=XBERPGM

 +7        XECUTE ^%ZOSF("TEST")

 +8        WRITE !

 +9        IF $TEST

               WRITE "Routine ^",XBERPGM," has been filed.",!

               IF 1

 +10      IF '$TEST

               WRITE "Saving of routine ^",XBERPGM," failed.",!

 +11       KILL ^TMP("XBERPGM",$JOB)

 +12       KILL XBERPGM,I,X,Y

 +13       QUIT 

 +14      ;

RTN       ; The routine to be loaded follows:

 +1       ;;ZIBVKMSM ; IHS/OHPRD/EDE - KILL VARIABLES [ 09/30/95  11:55 AM ]

 +2       ;; ;

 +3       ;; ; ZL this routine and ZS as ZIBVK

 +4       ;; ;

 +5       ;; ; This routine kills variables that begin with the string entered

 +6       ;; ; by the user.

 +7       ;; ;

 +8       ;; Q  ;        No entry from top

 +9       ;; ;

 +10      ;;EN(ZIBVKNS)        ;EP - KILL VARIABLES IN NAME SPACE

 +11      ;; Q:$G(ZIBVKNS)=""

 +12      ;; NEW ZIBVKX

 +13      ;; S ZIBVKX=$O(@ZIBVKNS,-1)

 +14      ;; S:ZIBVKX="" ZIBVKX="%"

 +15      ;; K:ZIBVKNS="%" @ZIBVKNS

 +16      ;; F  S ZIBVKX=$O(@ZIBVKX) Q:ZIBVKX=""  Q:$E(ZIBVKX,1,$L(ZIBVKNS))]ZIBVKNS  I $E(ZIBVKX,1,$L(ZIBVKNS))=ZIBVKNS,ZIBVKX'["ZIBVK" K @ZIBVKX

 +17      ;; Q