- 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 Feb 19, 2025@00:19:09 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 ;
