APCHCOMM.m

APCHCOMM ; IHS/TUCSON/LAB - ROUTINE AFTER USER COMMITS ;  [ 06/24/97  2:42 PM ]

 ;;2.0;IHS RPMS/PCC Health Summary;;JUN 24, 1997

 ;

 ;This routine changes the security key named APCHS CONFIDENTIAL to

 ;APCHZ CONFIDENTIAL to meet the Standards.

 ;

START ;  start of routine

 ; following line - quit if data exists

 Q:$D(^DIC(19.1,"B","APCHZ CONFIDENTIAL"))

 D LOOKUP ;                                  look-up security key

 Q:APCHQ

 L +^DIC(19.1,APCHDA):5 I '$T W !,"Sorry, this key is currently being edited.  Try later." G END

 D RCR1 ;                                copy node 1 of key (w/p field)

 D %XY^%RCR

 D CHGNAR ;                              change key name in description

 D DELETE ;                              delete old key

 D ADDKEY ;                              add key with new name

 D RCR2 ;                                copy node 1 of key (w/p field)

 D %XY^%RCR

 L -^DIC(19.1,APCHDA)

END ;  end of routine

 K ^APCHTMP(APCHDA)

 K APCHQ,APCHDA,APCHGBL

 Q

 ;

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

LOOKUP ;

 S APCHQ=1

 S APCHDA=$O(^DIC(19.1,"B","APCHS CONFIDENTIAL",0))

 Q:'APCHDA

 S APCHGBL="^DIC(19.1,"

 S APCHQ=0

 Q

 ;

RCR1 ;set vars to copy node 1 word-processing field to temporary global

 S %X=APCHGBL_APCHDA_",1,"

 S %Y="^APCHTMP("_APCHDA_",1,"

 Q

RCR2 ;set vars to copy node 1 word-processing field to ^DIC(19.1, global

 S %X="^APCHTMP("_APCHDA_",1,"

 S %Y=APCHGBL_APCHDA_",1,"

 Q

 ;

DELETE ;delete security key

 S DIK=APCHGBL,DA=APCHDA

 W !!,"......deleting SECURITY KEY:  APCHS CONFIDENTIAL",!!

 D ^DIK K DIK

 K D,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM

 Q

 ;

ADDKEY ; add APCHZ CONFIDENTIAL security key

 K DD,D0

 S DIC=APCHGBL,DIC(0)="OZ",X="APCHZ CONFIDENTIAL"

 S (DA,DINUM)=APCHDA

 W !!,"......renaming SECURITY KEY to APCHZ CONFIDENTIAL",!!

 D FILE^DICN

 K D,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM

 Q

 ;

CHGNAR ; change security key name in description

 S ^APCHTMP(APCHDA,1,2,0)="APCHZ CONFIDENTIAL will not appear on the health summary.  Note"

 Q

APCHCOMM  ; IHS/TUCSON/LAB - ROUTINE AFTER USER COMMITS ;  [ 06/24/97  2:42 PM ]

 +1       ;;2.0;IHS RPMS/PCC Health Summary;;JUN 24, 1997

 +2       ;

 +3       ;This routine changes the security key named APCHS CONFIDENTIAL to

 +4       ;APCHZ CONFIDENTIAL to meet the Standards.

 +5       ;

START     ;  start of routine

 +1       ; following line - quit if data exists

 +2        IF $DATA(^DIC(19.1,"B","APCHZ CONFIDENTIAL"))

               QUIT 

 +3       ;                                  look-up security key

           DO LOOKUP

 +4        IF APCHQ

               QUIT 

 +5        LOCK +^DIC(19.1,APCHDA):5

           IF '$TEST

               WRITE !,"Sorry, this key is currently being edited.  Try later."

               GOTO END

 +6       ;                                copy node 1 of key (w/p field)

           DO RCR1

 +7        DO %XY^%RCR

 +8       ;                              change key name in description

           DO CHGNAR

 +9       ;                              delete old key

           DO DELETE

 +10      ;                              add key with new name

           DO ADDKEY

 +11      ;                                copy node 1 of key (w/p field)

           DO RCR2

 +12       DO %XY^%RCR

 +13       LOCK -^DIC(19.1,APCHDA)

END       ;  end of routine

 +1        KILL ^APCHTMP(APCHDA)

 +2        KILL APCHQ,APCHDA,APCHGBL

 +3        QUIT 

 +4       ;

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

LOOKUP    ;

 +1        SET APCHQ=1

 +2        SET APCHDA=$ORDER(^DIC(19.1,"B","APCHS CONFIDENTIAL",0))

 +3        IF 'APCHDA

               QUIT 

 +4        SET APCHGBL="^DIC(19.1,"

 +5        SET APCHQ=0

 +6        QUIT 

 +7       ;

RCR1      ;set vars to copy node 1 word-processing field to temporary global

 +1        SET %X=APCHGBL_APCHDA_",1,"

 +2        SET %Y="^APCHTMP("_APCHDA_",1,"

 +3        QUIT 

RCR2      ;set vars to copy node 1 word-processing field to ^DIC(19.1, global

 +1        SET %X="^APCHTMP("_APCHDA_",1,"

 +2        SET %Y=APCHGBL_APCHDA_",1,"

 +3        QUIT 

 +4       ;

DELETE    ;delete security key

 +1        SET DIK=APCHGBL

           SET DA=APCHDA

 +2        WRITE !!,"......deleting SECURITY KEY:  APCHS CONFIDENTIAL",!!

 +3        DO ^DIK

           KILL DIK

 +4        KILL D,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM

 +5        QUIT 

 +6       ;

ADDKEY    ; add APCHZ CONFIDENTIAL security key

 +1        KILL DD,D0

 +2        SET DIC=APCHGBL

           SET DIC(0)="OZ"

           SET X="APCHZ CONFIDENTIAL"

 +3        SET (DA,DINUM)=APCHDA

 +4        WRITE !!,"......renaming SECURITY KEY to APCHZ CONFIDENTIAL",!!

 +5        DO FILE^DICN

 +6        KILL D,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM

 +7        QUIT 

 +8       ;

CHGNAR    ; change security key name in description

 +1        SET ^APCHTMP(APCHDA,1,2,0)="APCHZ CONFIDENTIAL will not appear on the health summary.  Note"

 +2        QUIT