XBKIDS.m

XBKIDS ; IHS/ASDST/GTH - KIDS UTILITIES ; [ 10/29/2002   7:42 AM ]

 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997

 ;

 ; IHS/SET/GTH XB*3*9 10/29/2002

 ;

 ; --------------------

 ;

VCHK(XBPRE,XBVER,XBQUIT) ;PEP - For environment check routines.

 ; Pass "PREFIX","Version","XPDQUIT_value".

 ; E.g.:  Q:'$$VCHK^XBKIDS("AG",5.4,2)

 ;  

 NEW XBV

 S XBV=$$VERSION^XPDUTL(XBPRE)

 W !,$$CJ^XLFSTR("Need at least "_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)

 I XBV<XBVER KILL DIFQ S XPDQUIT=XBQUIT W *7,!,$$CJ^XLFSTR("Sorry....",IOM) S XBV=$$DIR^XBDIR("E","Press RETURN") Q 0

 Q 1

 ;

 ; --------------------

 ;

P(XBP) ;PEP - Determine if patch XBP was installed.

 ; XBP must be in standard patch naming format.  E.g. "AG*6.0*13"

 ; ^DIC(9.4,D0,22,D1,PAH,D2,0)=

 ; (#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^ 

 ;

 NEW D,DIC,X,XB,Y

 S X=$P(XBP,"*",1),DIC="^DIC(9.4,",DIC(0)="F",D="C"

 D IX^DIC

 I Y<1 Q "PREFIX '"_$P(XBP,"*",1)_"' NOT FOUND IN PACKAGE FILE."

 S XB="^DIC(9.4,"_(+Y)_","

 ;

 KILL D

 S DIC=DIC_+Y_",22,",X=$P(XBP,"*",2)

 D ^DIC

 I Y<1 Q "VERSION '"_$P(XBP,"*",2)_"' NOT FOUND IN PACKAGE FILE."

 S XB=XB_"22,"_(+Y)_","

 ;

 S DIC=DIC_+Y_",""PAH"",",X=$P(XBP,"*",3)

 D ^DIC

 Q $S(Y>0:XB_"""PAH"","_(+Y)_",",1:"PATCH NUMBER '"_$P(XBP,"*",3)_"' NOT FOUND IN PACKAGE FILE.")

 ;

 ; --------------------

 ;

 ; OPTSAV() and OPTRES() are provided b/c if an option of type "menu"

 ; is included in a KIDS transport and install, the existing option

 ; is overwritten, thereby destroying any local modifications.

 ;

 ; Further, if an option of type "menu" is included in a KIDS transport

 ; and install, -all- the options on that option of type "menu" -must-

 ; be included in the KIDS transport, whether they are changed, or not.

 ;

 ; The value of XB2SUB is provided by the calling routine, and has no

 ; particular meaning.

 ;

 ; E.g.:  D OPTSAV^XBKIDS("AGMENU","Cochise")

 ;        D OPTRES^XBKIDS("AGMENU","Cochise")

 ;

OPTSAV(XBM,XB2SUB) ;PEP - Save the menu portion of an option.

 I $D(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM)) D BMES^XPDUTL("NOT SAVED.  Option '"_XBM_"' has previously been saved.") Q

 I '$D(^XTMP("XBKIDS")) S ^XTMP("XBKIDS",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"XBKIDS - SAVE OPTION CONFIGURATIONS."

 NEW I,A

 S I=$O(^DIC(19,"B",XBM,0))

 I 'I D BMES^XPDUTL("NOT SAVED.  Option '"_XBM_"' not found in OPTION file.") Q

 S A=0

 F  S A=$O(^DIC(19,I,10,A)) Q:'A  S ^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)

 Q

 ;

 ; --------------------

 ;

OPTRES(XBM,XB2SUB) ; PEP - Restore the menu portion of an option.

 NEW XB,XBI

 I '$D(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM)) D BMES^XPDUTL("FAILED.  Option '"_XBM_"' was not previously saved.") Q

 S XB=0

 F  S XB=$O(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM,XB)) Q:'XB  S XBI=^(XB) I '$$ADD^XPDMENU(XBM,$P(XBI,U,1),$P(XBI,U,2),$P(XBI,U,3)) D BMES^XPDUTL("....FAILED to re-atch "_$P(XBI,U,1)_" to "_XBM_".")

 Q

 ;

XBKIDS    ; IHS/ASDST/GTH - KIDS UTILITIES ; [ 10/29/2002   7:42 AM ]

 +1       ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997

 +2       ;

 +3       ; IHS/SET/GTH XB*3*9 10/29/2002

 +4       ;

 +5       ; --------------------

 +6       ;

VCHK(XBPRE,XBVER,XBQUIT) ;PEP - For environment check routines.

 +1       ; Pass "PREFIX","Version","XPDQUIT_value".

 +2       ; E.g.:  Q:'$$VCHK^XBKIDS("AG",5.4,2)

 +3       ;  

 +4        NEW XBV

 +5        SET XBV=$$VERSION^XPDUTL(XBPRE)

 +6        WRITE !,$$CJ^XLFSTR("Need at least "_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)

 +7        IF XBV<XBVER

               KILL DIFQ

               SET XPDQUIT=XBQUIT

               WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM)

               SET XBV=$$DIR^XBDIR("E","Press RETURN")

               QUIT 0

 +8        QUIT 1

 +9       ;

 +10      ; --------------------

 +11      ;

P(XBP)    ;PEP - Determine if patch XBP was installed.

 +1       ; XBP must be in standard patch naming format.  E.g. "AG*6.0*13"

 +2       ; ^DIC(9.4,D0,22,D1,PAH,D2,0)=

 +3       ; (#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^ 

 +4       ;

 +5        NEW D,DIC,X,XB,Y

 +6        SET X=$PIECE(XBP,"*",1)

           SET DIC="^DIC(9.4,"

           SET DIC(0)="F"

           SET D="C"

 +7        DO IX^DIC

 +8        IF Y<1

               QUIT "PREFIX '"_$PIECE(XBP,"*",1)_"' NOT FOUND IN PACKAGE FILE."

 +9        SET XB="^DIC(9.4,"_(+Y)_","

 +10      ;

 +11       KILL D

 +12       SET DIC=DIC_+Y_",22,"

           SET X=$PIECE(XBP,"*",2)

 +13       DO ^DIC

 +14       IF Y<1

               QUIT "VERSION '"_$PIECE(XBP,"*",2)_"' NOT FOUND IN PACKAGE FILE."

 +15       SET XB=XB_"22,"_(+Y)_","

 +16      ;

 +17       SET DIC=DIC_+Y_",""PAH"","

           SET X=$PIECE(XBP,"*",3)

 +18       DO ^DIC

 +19       QUIT $SELECT(Y>0:XB_"""PAH"","_(+Y)_",",1:"PATCH NUMBER '"_$PIECE(XBP,"*",3)_"' NOT FOUND IN PACKAGE FILE.")

 +20      ;

 +21      ; --------------------

 +22      ;

 +23      ; OPTSAV() and OPTRES() are provided b/c if an option of type "menu"

 +24      ; is included in a KIDS transport and install, the existing option

 +25      ; is overwritten, thereby destroying any local modifications.

 +26      ;

 +27      ; Further, if an option of type "menu" is included in a KIDS transport

 +28      ; and install, -all- the options on that option of type "menu" -must-

 +29      ; be included in the KIDS transport, whether they are changed, or not.

 +30      ;

 +31      ; The value of XB2SUB is provided by the calling routine, and has no

 +32      ; particular meaning.

 +33      ;

 +34      ; E.g.:  D OPTSAV^XBKIDS("AGMENU","Cochise")

 +35      ;        D OPTRES^XBKIDS("AGMENU","Cochise")

 +36      ;

OPTSAV(XBM,XB2SUB) ;PEP - Save the menu portion of an option.

 +1        IF $DATA(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM))

               DO BMES^XPDUTL("NOT SAVED.  Option '"_XBM_"' has previously been saved.")

               QUIT 

 +2        IF '$DATA(^XTMP("XBKIDS"))

               SET ^XTMP("XBKIDS",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"XBKIDS - SAVE OPTION CONFIGURATIONS."

 +3        NEW I,A

 +4        SET I=$ORDER(^DIC(19,"B",XBM,0))

 +5        IF 'I

               DO BMES^XPDUTL("NOT SAVED.  Option '"_XBM_"' not found in OPTION file.")

               QUIT 

 +6        SET A=0

 +7        FOR 

               SET A=$ORDER(^DIC(19,I,10,A))

               IF 'A

                   QUIT 

               SET ^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM,A)=$PIECE(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$PIECE(^DIC(19,I,10,A,0),U,2,3)

 +8        QUIT 

 +9       ;

 +10      ; --------------------

 +11      ;

OPTRES(XBM,XB2SUB) ; PEP - Restore the menu portion of an option.

 +1        NEW XB,XBI

 +2        IF '$DATA(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM))

               DO BMES^XPDUTL("FAILED.  Option '"_XBM_"' was not previously saved.")

               QUIT 

 +3        SET XB=0

 +4        FOR 

               SET XB=$ORDER(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM,XB))

               IF 'XB

                   QUIT 

               SET XBI=^(XB)

               IF '$$ADD^XPDMENU(XBM,$PIECE(XBI,U,1),$PIECE(XBI,U,2),$PIECE(XBI,U,3))

                   DO BMES^XPDUTL("....FAILED to re-atch "_$PIECE(XBI,U,1)_" to "_XBM_".")

 +5        QUIT 

 +6       ;