SDECSTNG ; ALB/WTC - VISTA SCHEDULING - Settings Utilities ;MAY 16,2018@09:48
;;5.3;Scheduling;**694,756**;;Build 43
;;Per VHA Directive 2004-038, this routine should not be modified
Q ;
;
HELPLINK(SDECY) ;
;
; Extract help text and URLs from SDEC Settings file (#409.98)
;
N SDECI,CTR ;
S SDECI=0 ;
S SDECY="^TMP(""SDECSTNG"","_$J_",""HELPLINK"")" ;
K @SDECY ;
S @SDECY@(SDECI)="T00030ID^T00030TEXT^T00255URL"_$C(30) ;
;
; Get help text, url and source for the national hyperlinks
;
S CTR=0 D LOAD(1) ;
;
; Get help text, url and source for the local hyperlinks
;
D LOAD(2) ;
;
; Return links
;
S SDECI=SDECI+1 ;
S @SDECY@(SDECI)=$C(31)
Q
;
LOAD(SITE) ;
;
; Load URLs for a site into output array.
;
N DA,X,Y ;
S DA=0 F S DA=$O(^SDEC(409.98,SITE,1,DA)) Q:'DA D ;
. ;
. ; Generate link based on type, address and mail subject.
. ;
. S CTR=CTR+1,X=CTR_"^"_$P(^SDEC(409.98,SITE,1,DA,0),"^",1)_"^" ;
. S X=X_$S($P(^SDEC(409.98,SITE,1,DA,0),"^",2)=1:"http://",$P(^(0),"^",2)=2:"https://",$P(^(0),"^",2)=3:"mailto:",1:"")_^(1) ;
. ;
. ; If link is a mail link with a subject, append "?subject=" and the encoded subject.
. ;
. I $G(^SDEC(409.98,SITE,1,DA,2))'="" S Y=^(2) X "S Y=$ZCONVERT(Y,""O"",""URL"")" S X=X_"?subject="_Y ;
. S SDECI=SDECI+1,@SDECY@(SDECI)=X_$C(30) Q ;
Q
;
SERVER ; Entry point for server option to kick off file update.
;
; Update SDEC Settings file (#409.98) from messages sent through SDECSETTINGS mail group.
;
; SD*5.3*694 wtc/zeb 8/29/2018
;
; ID of triggering message is in assumed variable XMZ
; Call to XMXAPI covered by IA #2729
; Call to XMXUTIL2 covered by IA #2736
;
N MESSAGE,SDECXMZ,X,GUIVERS,EFFDATE,Y,CMTLNGTH,I,HASHTAG,CMTTEXT,ACTION,DIC,DIK,DA,STOPCODE ;
;
S SDECXMZ=$G(XMZ) Q:SDECXMZ="" ; Message unknown.
;
D:$$SUBJ^XMXUTIL2($G(^XMB(3.9,SDECXMZ,0)))["SDEC SETTINGS REMOTE UPDATE" ;
. ;
. ; Check message text for action to take.
. ;
. ;F I=1:1 Q:$G(^XMB(3.9,SDECXMZ,2,I,0))="" S MESSAGE=^(0) D ;
. N XMZ,XMER S XMZ=SDECXMZ F S MESSAGE=$$READ^XMGAPI1() Q:XMER<0 D ; Modified to use MailMan API - 756 WTC 7/23/2020 - ICR #1048
.. ;
.. ; Process version change. Data is "VERSION^version number^effective date (external)"
.. ;
.. I $P(MESSAGE,U,1)="VERSION" D Q ;
... S GUIVERS=$P(MESSAGE,U,2),EFFDATE=$P(MESSAGE,U,3) ;
... S Y=$$NETTOFM^SDECDATE(EFFDATE,"N") ;
... S $P(^SDEC(409.98,2,0),"^",2,3)=GUIVERS_"^"_Y ;
.. ;
.. ; Process changes to canned comments. Data is "CANCELLATION COMMENT^action^hash tag^text equivalent"
.. ; "action" can be "ADD" or "DELETE".
.. ;
.. I $P(MESSAGE,U,1)="CANCELLATION COMMENT" D Q ;
... S ACTION=$P(MESSAGE,U,2),HASHTAG=$$STRIP($P(MESSAGE,U,3)),CMTTEXT=$$STRIP($P(MESSAGE,U,4)) ;
... ;
... I ACTION="ADD" D Q ;
.... I CMTTEXT="" D APPERROR^%ZTER("Entry ("_HASHTAG_") could not be added to file #409.88. Text missing.") Q ;
.... S DA=0 F S DA=$O(^SDEC(409.88,"B",HASHTAG,DA)) Q:'DA Q:$P(^SDEC(409.88,DA,0),U,3)=1 ; Find national hashtag match
.... I DA D APPERROR^%ZTER("Entry ("_HASHTAG_") could not be added to file #409.88. It already exists.") Q ;
.... K DIC,DA S X=HASHTAG,DIC="^SDEC(409.88,",DIC(0)="L",DIC("DR")="1///"_CMTTEXT_";2///1" D FILE^DICN Q:Y>0 ;
.... D APPERROR^%ZTER("Entry ("_HASHTAG_") could not be added to file #409.88") Q ;
... ;
... I ACTION="DELETE" D Q ;
.... K DIK,DA ;
.... S DIK="^SDEC(409.88," ;
.... S DA=0 F S DA=$O(^SDEC(409.88,"B",HASHTAG,DA)) Q:'DA Q:$P(^SDEC(409.88,DA,0),U,3)=1 ; Find national hashtag match
.... I 'DA D APPERROR^%ZTER("Entry ("_HASHTAG_") not on file for deletion from file #409.88") Q ;
.... D ^DIK ;
.. ;
.. ; Process changes to VVC stop codes. Data is "VVC STOP CODE^action^stop code^"
.. ; "action" can be "ADD" or "DELETE".
.. ;
.. I $P(MESSAGE,U,1)="VVC STOP CODE" D Q ;
... S ACTION=$P(MESSAGE,U,2),STOPCODE=$$STRIP($P(MESSAGE,U,3)) ;
... ;
... I 'STOPCODE D APPERROR^%ZTER("Invalid stop code ("_STOPCODE_"). No action taken in file #409.98") Q ;
... I '$O(^DIC(40.7,"C",STOPCODE)) D APPERROR^%ZTER("Undefined stop code ("_STOPCODE_"). No action taken in file #409.98") Q ;
... ;
... I ACTION="ADD" D Q ;
.... S DA=$O(^SDEC(409.98,1,3,"B",STOPCODE,0)) ; Find stop code
.... I DA D APPERROR^%ZTER("Stop code ("_STOPCODE_") could not be added to file #409.98. It already exists.") Q ;
.... K DIC,DA S DA(1)=1,X=STOPCODE,DIC="^SDEC(409.98,1,3,",DIC(0)="L" D FILE^DICN Q:Y>0 ;
.... D APPERROR^%ZTER("Stop code ("_STOPCODE_") could not be added to file #409.98") Q ;
... ;
... I ACTION="DELETE" D Q ;
.... K DIC,DIK,DA ;
.... S DA(1)=1,DA=$O(^SDEC(409.98,1,3,"B",STOPCODE,0)) ; Find stop code
.... I 'DA D APPERROR^%ZTER("Stop code ("_STOPCODE_") not on file for deletion from file #409.98") Q ;
.... S DIK="^SDEC(409.98,1,3," ;
.... D ^DIK ;
;
N ZTREQ ;
D ZAPSERV^XMXAPI("S.SDEC SETTINGS REMOTE UPDATE",SDECXMZ) ;
S ZTREQ="@" ;
Q ;
;
STRIP(X) ; Strip off trailing spaces.
;
I $E(X,$L(X))=" " S X=$E(X,1,$L(X)-1),X=$$STRIP(X) ;
Q X ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECSTNG 5189 printed Oct 16, 2024@18:53:17 Page 2
SDECSTNG ; ALB/WTC - VISTA SCHEDULING - Settings Utilities ;MAY 16,2018@09:48
+1 ;;5.3;Scheduling;**694,756**;;Build 43
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
QUIT
+4 ;
HELPLINK(SDECY) ;
+1 ;
+2 ; Extract help text and URLs from SDEC Settings file (#409.98)
+3 ;
+4 ;
NEW SDECI,CTR
+5 ;
SET SDECI=0
+6 ;
SET SDECY="^TMP(""SDECSTNG"","_$JOB_",""HELPLINK"")"
+7 ;
KILL @SDECY
+8 ;
SET @SDECY@(SDECI)="T00030ID^T00030TEXT^T00255URL"_$CHAR(30)
+9 ;
+10 ; Get help text, url and source for the national hyperlinks
+11 ;
+12 ;
SET CTR=0
DO LOAD(1)
+13 ;
+14 ; Get help text, url and source for the local hyperlinks
+15 ;
+16 ;
DO LOAD(2)
+17 ;
+18 ; Return links
+19 ;
+20 ;
SET SDECI=SDECI+1
+21 SET @SDECY@(SDECI)=$CHAR(31)
+22 QUIT
+23 ;
LOAD(SITE) ;
+1 ;
+2 ; Load URLs for a site into output array.
+3 ;
+4 ;
NEW DA,X,Y
+5 ;
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.98,SITE,1,DA))
if 'DA
QUIT
Begin DoDot:1
+6 ;
+7 ; Generate link based on type, address and mail subject.
+8 ;
+9 ;
SET CTR=CTR+1
SET X=CTR_"^"_$PIECE(^SDEC(409.98,SITE,1,DA,0),"^",1)_"^"
+10 ;
SET X=X_$SELECT($PIECE(^SDEC(409.98,SITE,1,DA,0),"^",2)=1:"http://",$PIECE(^(0),"^",2)=2:"https://",$PIECE(^(0),"^",2)=3:"mailto:",1:"")_^(1)
+11 ;
+12 ; If link is a mail link with a subject, append "?subject=" and the encoded subject.
+13 ;
+14 ;
IF $GET(^SDEC(409.98,SITE,1,DA,2))'=""
SET Y=^(2)
XECUTE "S Y=$ZCONVERT(Y,""O"",""URL"")"
SET X=X_"?subject="_Y
+15 ;
SET SDECI=SDECI+1
SET @SDECY@(SDECI)=X_$CHAR(30)
QUIT
End DoDot:1
+16 QUIT
+17 ;
SERVER ; Entry point for server option to kick off file update.
+1 ;
+2 ; Update SDEC Settings file (#409.98) from messages sent through SDECSETTINGS mail group.
+3 ;
+4 ; SD*5.3*694 wtc/zeb 8/29/2018
+5 ;
+6 ; ID of triggering message is in assumed variable XMZ
+7 ; Call to XMXAPI covered by IA #2729
+8 ; Call to XMXUTIL2 covered by IA #2736
+9 ;
+10 ;
NEW MESSAGE,SDECXMZ,X,GUIVERS,EFFDATE,Y,CMTLNGTH,I,HASHTAG,CMTTEXT,ACTION,DIC,DIK,DA,STOPCODE
+11 ;
+12 ; Message unknown.
SET SDECXMZ=$GET(XMZ)
if SDECXMZ=""
QUIT
+13 ;
+14 ;
if $$SUBJ^XMXUTIL2($GET(^XMB(3.9,SDECXMZ,0)))["SDEC SETTINGS REMOTE UPDATE"
Begin DoDot:1
+15 ;
+16 ; Check message text for action to take.
+17 ;
+18 ;F I=1:1 Q:$G(^XMB(3.9,SDECXMZ,2,I,0))="" S MESSAGE=^(0) D ;
+19 ; Modified to use MailMan API - 756 WTC 7/23/2020 - ICR #1048
NEW XMZ,XMER
SET XMZ=SDECXMZ
FOR
SET MESSAGE=$$READ^XMGAPI1()
if XMER<0
QUIT
Begin DoDot:2
+20 ;
+21 ; Process version change. Data is "VERSION^version number^effective date (external)"
+22 ;
+23 ;
IF $PIECE(MESSAGE,U,1)="VERSION"
Begin DoDot:3
+24 ;
SET GUIVERS=$PIECE(MESSAGE,U,2)
SET EFFDATE=$PIECE(MESSAGE,U,3)
+25 ;
SET Y=$$NETTOFM^SDECDATE(EFFDATE,"N")
+26 ;
SET $PIECE(^SDEC(409.98,2,0),"^",2,3)=GUIVERS_"^"_Y
End DoDot:3
QUIT
+27 ;
+28 ; Process changes to canned comments. Data is "CANCELLATION COMMENT^action^hash tag^text equivalent"
+29 ; "action" can be "ADD" or "DELETE".
+30 ;
+31 ;
IF $PIECE(MESSAGE,U,1)="CANCELLATION COMMENT"
Begin DoDot:3
+32 ;
SET ACTION=$PIECE(MESSAGE,U,2)
SET HASHTAG=$$STRIP($PIECE(MESSAGE,U,3))
SET CMTTEXT=$$STRIP($PIECE(MESSAGE,U,4))
+33 ;
+34 ;
IF ACTION="ADD"
Begin DoDot:4
+35 ;
IF CMTTEXT=""
DO APPERROR^%ZTER("Entry ("_HASHTAG_") could not be added to file #409.88. Text missing.")
QUIT
+36 ; Find national hashtag match
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.88,"B",HASHTAG,DA))
if 'DA
QUIT
if $PIECE(^SDEC(409.88,DA,0),U,3)=1
QUIT
+37 ;
IF DA
DO APPERROR^%ZTER("Entry ("_HASHTAG_") could not be added to file #409.88. It already exists.")
QUIT
+38 ;
KILL DIC,DA
SET X=HASHTAG
SET DIC="^SDEC(409.88,"
SET DIC(0)="L"
SET DIC("DR")="1///"_CMTTEXT_";2///1"
DO FILE^DICN
if Y>0
QUIT
+39 ;
DO APPERROR^%ZTER("Entry ("_HASHTAG_") could not be added to file #409.88")
QUIT
End DoDot:4
QUIT
+40 ;
+41 ;
IF ACTION="DELETE"
Begin DoDot:4
+42 ;
KILL DIK,DA
+43 ;
SET DIK="^SDEC(409.88,"
+44 ; Find national hashtag match
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.88,"B",HASHTAG,DA))
if 'DA
QUIT
if $PIECE(^SDEC(409.88,DA,0),U,3)=1
QUIT
+45 ;
IF 'DA
DO APPERROR^%ZTER("Entry ("_HASHTAG_") not on file for deletion from file #409.88")
QUIT
+46 ;
DO ^DIK
End DoDot:4
QUIT
End DoDot:3
QUIT
+47 ;
+48 ; Process changes to VVC stop codes. Data is "VVC STOP CODE^action^stop code^"
+49 ; "action" can be "ADD" or "DELETE".
+50 ;
+51 ;
IF $PIECE(MESSAGE,U,1)="VVC STOP CODE"
Begin DoDot:3
+52 ;
SET ACTION=$PIECE(MESSAGE,U,2)
SET STOPCODE=$$STRIP($PIECE(MESSAGE,U,3))
+53 ;
+54 ;
IF 'STOPCODE
DO APPERROR^%ZTER("Invalid stop code ("_STOPCODE_"). No action taken in file #409.98")
QUIT
+55 ;
IF '$ORDER(^DIC(40.7,"C",STOPCODE))
DO APPERROR^%ZTER("Undefined stop code ("_STOPCODE_"). No action taken in file #409.98")
QUIT
+56 ;
+57 ;
IF ACTION="ADD"
Begin DoDot:4
+58 ; Find stop code
SET DA=$ORDER(^SDEC(409.98,1,3,"B",STOPCODE,0))
+59 ;
IF DA
DO APPERROR^%ZTER("Stop code ("_STOPCODE_") could not be added to file #409.98. It already exists.")
QUIT
+60 ;
KILL DIC,DA
SET DA(1)=1
SET X=STOPCODE
SET DIC="^SDEC(409.98,1,3,"
SET DIC(0)="L"
DO FILE^DICN
if Y>0
QUIT
+61 ;
DO APPERROR^%ZTER("Stop code ("_STOPCODE_") could not be added to file #409.98")
QUIT
End DoDot:4
QUIT
+62 ;
+63 ;
IF ACTION="DELETE"
Begin DoDot:4
+64 ;
KILL DIC,DIK,DA
+65 ; Find stop code
SET DA(1)=1
SET DA=$ORDER(^SDEC(409.98,1,3,"B",STOPCODE,0))
+66 ;
IF 'DA
DO APPERROR^%ZTER("Stop code ("_STOPCODE_") not on file for deletion from file #409.98")
QUIT
+67 ;
SET DIK="^SDEC(409.98,1,3,"
+68 ;
DO ^DIK
End DoDot:4
QUIT
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+69 ;
+70 ;
NEW ZTREQ
+71 ;
DO ZAPSERV^XMXAPI("S.SDEC SETTINGS REMOTE UPDATE",SDECXMZ)
+72 ;
SET ZTREQ="@"
+73 ;
QUIT
+74 ;
STRIP(X) ; Strip off trailing spaces.
+1 ;
+2 ;
IF $EXTRACT(X,$LENGTH(X))=" "
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
SET X=$$STRIP(X)
+3 ;
QUIT X
+4 ;
