Routine: AWCMCPST

AWCMCPST ;VISN 7/THM-POST-INIT FOR CPRS MONITOR ; Feb 27, 2004

 ;;7.3;TOOLKIT;**84,86**;Jan 09, 2004

EN ; set up ^XTMP nodes first

 N AWCPGDT,X,Y

 D DT^DICRW

 S X="T+10",%DT="" D ^%DT Q:Y<0  S AWCPGDT=Y

 ; locks applied even though nodes do not exist yet

 I '$D(^XTMP("AWCCPRS",0)) DO

 .L +^XTMP("AWCCPRS",0):1

 .S ^XTMP("AWCCPRS",0)=AWCPGDT_U_DT_U_"CPRS Monitor temporary global" ;zero node

 .L -^XTMP("AWCCPRS",0)

 I '$D(^XTMP("AWCCPRS",.5)) DO

 .L +^XTMP("AWCCPRS",.5):1

 .S ^XTMP("AWCCPRS",.5)=0 ;node that supplies IEN

 .L -^XTMP("AWCCPRS",.5)

PARAM ; set up parameter file; all settings off initially

 S AWCX=$$SITE^VASITE,AWCDIV=+AWCX,AWCDNAME=$P(AWCX,U,2),AWCMSTA=$P(AWCX,U,3)

 ; Output= Institution file pointer^Institution name^station number with suffix

 I AWCDIV="" W !!,$C(7),"Unable to resolve the site's station number",!! H 3

 G:AWCDIV="" EXIT

 ; Beta test sites have it already, so update it for consistency

 I $D(^AWC(177100.12,1,0)) DO  G EXIT

 .S (DIC,DIE)="^AWC(177100.12,",DIC(0)="QLM",DA=1

 .; set the first piece manually; can't edit a DINUMed field

 .; field 1.5 will be triggered on new entries at non-beta sites, but not for existing beta sites

 .S $P(^AWC(177100.12,DA,0),U)=AWCDIV

 .S DR="1///0;1.2///0;1.5////"_AWCMSTA_";2///0;3///0;5////cprsmonitor"_AWCMSTA

 .S DR=DR_";6///8;7///30;8///192,0,0;9///0,192,0;10///0,0,192;11///1;12///230,230,230"

 .S DR=DR_";13///7;20///vaftp.domain.ext;21////itmuser;22////Padfoot1;23///0;24///1"

 .D ^DIE

 . ;now re-index .01 field because it changed (DIK executes KILL and then SET)

 .S DIK="^AWC(177100.12,",DA=1,DIK(1)=".01" D EN^DIK

 ; section for new sites - field 1.5 is triggered

 I '$D(^AWC(177100.12,1,0)) DO

 .S X=AWCDIV,DIC("DR")="1///0;1.2///0;2///0;3///0;5///cprsmonitor"_AWCMSTA

 .S DIC("DR")=DIC("DR")_";6///8;7///30;8///192,0,0;9///0,192,0;10///0,0,192;11///YES;12///230,230,230"

 .S DIC("DR")=DIC("DR")_";13///7;20///vaftp.domain.ext;21///itmuser;22///Padfoot1;23///0;24///1"

 .S (DIC,DIE)="^AWC(177100.12,",DIC(0)="EQLM" K DO,DD D FILE^DICN

EXIT K AWCDIV,AWCDA,AWCDNAME,AWCMSTA,DO,DD,DIC,DIE,DR,%DT,AWCPGDT,X,Y

 K AWCX,DA

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAWCMCPST   2161     printed  Mar 13, 2025@21:43:52                                                                                                                                                                                                    Page 2

AWCMCPST  ;VISN 7/THM-POST-INIT FOR CPRS MONITOR ; Feb 27, 2004

 +1       ;;7.3;TOOLKIT;**84,86**;Jan 09, 2004

 +2       ;

EN        ; set up ^XTMP nodes first

 +1        NEW AWCPGDT,X,Y

 +2        DO DT^DICRW

 +3        SET X="T+10"

           SET %DT=""

           DO ^%DT

           if Y<0

               QUIT

           SET AWCPGDT=Y

 +4       ; locks applied even though nodes do not exist yet

 +5        IF '$DATA(^XTMP("AWCCPRS",0))

               Begin DoDot:1

 +6                LOCK +^XTMP("AWCCPRS",0):1

 +7       ;zero node

                   SET ^XTMP("AWCCPRS",0)=AWCPGDT_U_DT_U_"CPRS Monitor temporary global"

 +8                LOCK -^XTMP("AWCCPRS",0)

               End DoDot:1

 +9        IF '$DATA(^XTMP("AWCCPRS",.5))

               Begin DoDot:1

 +10               LOCK +^XTMP("AWCCPRS",.5):1

 +11      ;node that supplies IEN

                   SET ^XTMP("AWCCPRS",.5)=0

 +12               LOCK -^XTMP("AWCCPRS",.5)

               End DoDot:1

 +13      ;

PARAM     ; set up parameter file; all settings off initially

 +1        SET AWCX=$$SITE^VASITE

           SET AWCDIV=+AWCX

           SET AWCDNAME=$PIECE(AWCX,U,2)

           SET AWCMSTA=$PIECE(AWCX,U,3)

 +2       ; Output= Institution file pointer^Institution name^station number with suffix

 +3        IF AWCDIV=""

               WRITE !!,$CHAR(7),"Unable to resolve the site's station number",!!

               HANG 3

 +4        if AWCDIV=""

               GOTO EXIT

 +5       ; Beta test sites have it already, so update it for consistency

 +6        IF $DATA(^AWC(177100.12,1,0))

               Begin DoDot:1

 +7                SET (DIC,DIE)="^AWC(177100.12,"

                   SET DIC(0)="QLM"

                   SET DA=1

 +8       ; set the first piece manually; can't edit a DINUMed field

 +9       ; field 1.5 will be triggered on new entries at non-beta sites, but not for existing beta sites

 +10               SET $PIECE(^AWC(177100.12,DA,0),U)=AWCDIV

 +11               SET DR="1///0;1.2///0;1.5////"_AWCMSTA_";2///0;3///0;5////cprsmonitor"_AWCMSTA

 +12               SET DR=DR_";6///8;7///30;8///192,0,0;9///0,192,0;10///0,0,192;11///1;12///230,230,230"

 +13               SET DR=DR_";13///7;20///vaftp.domain.ext;21////itmuser;22////Padfoot1;23///0;24///1"

 +14               DO ^DIE

 +15      ;now re-index .01 field because it changed (DIK executes KILL and then SET)

 +16               SET DIK="^AWC(177100.12,"

                   SET DA=1

                   SET DIK(1)=".01"

                   DO EN^DIK

               End DoDot:1

               GOTO EXIT

 +17      ; section for new sites - field 1.5 is triggered

 +18       IF '$DATA(^AWC(177100.12,1,0))

               Begin DoDot:1

 +19               SET X=AWCDIV

                   SET DIC("DR")="1///0;1.2///0;2///0;3///0;5///cprsmonitor"_AWCMSTA

 +20               SET DIC("DR")=DIC("DR")_";6///8;7///30;8///192,0,0;9///0,192,0;10///0,0,192;11///YES;12///230,230,230"

 +21               SET DIC("DR")=DIC("DR")_";13///7;20///vaftp.domain.ext;21///itmuser;22///Padfoot1;23///0;24///1"

 +22               SET (DIC,DIE)="^AWC(177100.12,"

                   SET DIC(0)="EQLM"

                   KILL DO,DD

                   DO FILE^DICN

               End DoDot:1

 +23      ;

EXIT       KILL AWCDIV,AWCDA,AWCDNAME,AWCMSTA,DO,DD,DIC,DIE,DR,%DT,AWCPGDT,X,Y

 +1        KILL AWCX,DA

 +2        QUIT

AWCMCPST.m