ATSTEMP ; IHS/CMI/LAB - MANAGE SEARCH TEMPLATES ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
D INIT,CALLDIK,CHECK,MAIL:$D(ATSENDML)
D EOJ
Q
;
INIT ;
S U="^",ATSCREEN=""
I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
K ^UTILITY("ATSMANAGE")
Q
;
CALLDIK ;DELETE SEARCH TEMPLATES NOT INDICATED AS SAVE IN SEARCH TEMPLATE FILE
S ATSDA=0 F L=0:0 S ATSDA=$O(^ATSMNG(ATSDA)) Q:'ATSDA D
.I $P(^DIBT(ATSDA,0),U,1)="RPMS DEMO PATIENT NAMES" Q
.I $P($G(^BGPSITE(DUZ(2),0)),U,12)=ATSDA Q
.S:$P(^ATSMNG(ATSDA,0),U,2)'="Y"&('$D(^ATSMGR(ATSDA))) ATSDIBT="" S DA=ATSDA,DIK="^ATSMNG(" D ^DIK I $D(ATSDIBT) S DA=ATSDA,DIK="^DIBT(" D ^DIK K DIK,DA,ATSDIBT
Q
;
CHECK ;FIND SEARCH TEMPLATES>30 DAYS OLD
;S ATSX=0 F L=0:0 S ATSX=$O(^DIBT(ATSX)) Q:ATSX'=+ATSX I $D(^DIBT(ATSX,1))!$D(^DIBT(ATSX,"DIS")),$P(^DIBT(ATSX,0),U,2)+30<DT,'$D(^ATSMGR(ATSX)) D SETUP
S ATSX=0 F L=0:0 S ATSX=$O(^DIBT(ATSX)) Q:ATSX'=+ATSX D
.Q:$P(^DIBT(ATSX,0),U,2)="" ;no date
.S ATSND=$$FMADD^XLFDT($P(^DIBT(ATSX,0),U,2),365)
.I $D(^DIBT(ATSX,1))!$D(^DIBT(ATSX,"DIS")),ATSND<DT,'$D(^ATSMGR(ATSX)) D SETUP ;WHAT IF 0 NODE NOT DEFINED-DONT BLOW UP BY ADDING THE $G IHS/OKCAO/POC 1/17/00
Q
;
SETUP ;UTILITY NODES FOR CREATING BULLETIN
S (ATSCNT,ATSNODE)=0 F L=0:0 S ATSNODE=$O(^DIBT(ATSX,1,ATSNODE)) Q:'ATSNODE S ATSCNT=ATSCNT+1 I $D(ATSNTSK) W:'(ATSCNT#50) "."
Q:'$D(^DIBT(ATSX,0)) ;QUIT IF NO ZERO NODE IHS/OKCAO/POC 1/17/00
Q:$P(^DIBT(ATSX,0),U,1)="RPMS DEMO PATIENT NAMES"
I $P($G(^BGPSITE(DUZ(2),0)),U,12)=ATSX Q
S ATSNODE=^DIBT(ATSX,0)
S ATSDUZ=$P(ATSNODE,U,5) G:'ATSDUZ!(ATSDUZ="@")!('$O(^VA(200,ATSDUZ))) A
S ATSNAME=$P(ATSNODE,U)
S ATSFILEN=$P(ATSNODE,U,4) S ATSFILE=$S('ATSFILEN:"FILE NAME UNKNOWN",1:$P(^DIC(ATSFILEN,0),U)) S:'ATSFILEN ATSFILEN="FILE NUMBER UNKNOWN"
S Y=$P(ATSNODE,U,2) X:Y]"" ^DD("DD") S ATSDATE=$S(Y]"":Y,1:"NO DATE INDICATED")
S ^UTILITY("ATSMANAGE",$J,ATSDUZ,ATSNAME,ATSFILE,ATSFILEN,ATSDATE,ATSCNT)=""
S ATSENDML="" ;NOW KNOW THERE IS MAIL TO SEND
D SEARCH
A Q
;
SEARCH ;ENTER TEMPLATES INTO SEARCH TEMPLATE FILE
S X="`"_ATSX,DIC(0)="FML",DIC="^ATSMNG(",DLAYGO=9002220,DIADD=1,DIC("DR")=".03///"_ATSDUZ D ^DIC K DIC,DLAYGO,DIADD
Q
;
MAIL ;SEND MAIL MESSAGES TO USERS RE:TEMPLATES
S XMDUZ=.5,XMTEXT="ATSMAIL("
S XMSUB="*** NOTICE OF SEARCH TEMPLATE(S) DELETION ***"
S ATSMAIL(1,0)="THE FOLLOWING SEARCH TEMPLATE(S) WILL BE DELETED IN 60 DAYS UNLESS YOU INDICATE",ATSMAIL(2,0)="OTHERWISE WITHIN THE SAVE SEARCH TEMPLATE OPTION EITHER ON THE SEARCH TEMPLATE"
S ATSMAIL(3,0)="SYSTEM MENU OR ON ANOTHER MENU YOU HAVE ACCESS TO. CONTACT YOUR SITE MANAGER",ATSMAIL(4,0)="IF YOU HAVE ANY QUESTIONS.",ATSMAIL(5,0)=" "
S (ATSDUZ,ATSNAME)=0
F L=0:0 S ATSDUZ=$O(^UTILITY("ATSMANAGE",$J,ATSDUZ)) Q:'ATSDUZ S ATSUB=5 D MAILVAR,SENDMSG
Q
;
MAILVAR ;SET UP VARIABLES FOR MAIL MESSAGE
F L=0:0 S ATSNAME=$O(^UTILITY("ATSMANAGE",$J,ATSDUZ,ATSNAME)) Q:ATSNAME="" S ATSFILE=$O(^(ATSNAME,"")),ATSFILEN=$O(^(ATSFILE,"")),ATSDATE=$O(^(ATSFILEN,"")),ATSCNT=$O(^(ATSDATE,"")) D CONTLOOP
Q
;
CONTLOOP ;SET UP MORE VARIABLES FOR MAIL MESSAGE
S ATSUB=ATSUB+1,ATSMAIL(ATSUB,0)="TEMPLATE NAME: "_ATSNAME
S ATSUB=ATSUB+1,ATSMAIL(ATSUB,0)="FILE NAME: "_ATSFILE_" FILE NUMBER: "_ATSFILEN
S ATSUB=ATSUB+1,ATSMAIL(ATSUB,0)="DATE TEMPLATE CREATED: "_ATSDATE
S ATSUB=ATSUB+1,ATSMAIL(ATSUB,0)="NUMBER OF SEARCH TEMPLATE ENTRIES: "_ATSCNT
S ATSUB=ATSUB+1,ATSMAIL(ATSUB,0)=" "
Q
;
SENDMSG ;SENDS MESSAGE TO USER
S XMY(ATSDUZ)=""
D ^XMD
K ATSMAIL
Q
;
EOJ ;
K ATSX,ATSCREEN,ATSDA,ATSDUZ,ATSNAME,ATSFILE,ATSCNT,ATSNODE,ATSDIBT,ATSDATE,ATSENDML,ATSFILN,ATSUB,ATSMAIL,^UTILITY("ATSMANAGE")
Q
;
ATSTEMP ; IHS/CMI/LAB - MANAGE SEARCH TEMPLATES ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 DO INIT
DO CALLDIK
DO CHECK
IF $DATA(ATSENDML)
DO MAIL
+4 DO EOJ
+5 QUIT
+6 ;
INIT ;
+1 SET U="^"
SET ATSCREEN=""
+2 IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
SET DT=Y
+3 KILL ^UTILITY("ATSMANAGE")
+4 QUIT
+5 ;
CALLDIK ;DELETE SEARCH TEMPLATES NOT INDICATED AS SAVE IN SEARCH TEMPLATE FILE
+1 SET ATSDA=0
FOR L=0:0
SET ATSDA=$ORDER(^ATSMNG(ATSDA))
IF 'ATSDA
QUIT
Begin DoDot:1
+2 IF $PIECE(^DIBT(ATSDA,0),U,1)="RPMS DEMO PATIENT NAMES"
QUIT
+3 IF $PIECE($GET(^BGPSITE(DUZ(2),0)),U,12)=ATSDA
QUIT
+4 IF $PIECE(^ATSMNG(ATSDA,0),U,2)'="Y"&('$DATA(^ATSMGR(ATSDA)))
SET ATSDIBT=""
SET DA=ATSDA
SET DIK="^ATSMNG("
DO ^DIK
IF $DATA(ATSDIBT)
SET DA=ATSDA
SET DIK="^DIBT("
DO ^DIK
KILL DIK,DA,ATSDIBT
End DoDot:1
+5 QUIT
+6 ;
CHECK ;FIND SEARCH TEMPLATES>30 DAYS OLD
+1 ;S ATSX=0 F L=0:0 S ATSX=$O(^DIBT(ATSX)) Q:ATSX'=+ATSX I $D(^DIBT(ATSX,1))!$D(^DIBT(ATSX,"DIS")),$P(^DIBT(ATSX,0),U,2)+30<DT,'$D(^ATSMGR(ATSX)) D SETUP
+2 SET ATSX=0
FOR L=0:0
SET ATSX=$ORDER(^DIBT(ATSX))
IF ATSX'=+ATSX
QUIT
Begin DoDot:1
+3 ;no date
IF $PIECE(^DIBT(ATSX,0),U,2)=""
QUIT
+4 SET ATSND=$$FMADD^XLFDT($PIECE(^DIBT(ATSX,0),U,2),365)
+5 ;WHAT IF 0 NODE NOT DEFINED-DONT BLOW UP BY ADDING THE $G IHS/OKCAO/POC 1/17/00
IF $DATA(^DIBT(ATSX,1))!$DATA(^DIBT(ATSX,"DIS"))
IF ATSND<DT
IF '$DATA(^ATSMGR(ATSX))
DO SETUP
End DoDot:1
+6 QUIT
+7 ;
SETUP ;UTILITY NODES FOR CREATING BULLETIN
+1 SET (ATSCNT,ATSNODE)=0
FOR L=0:0
SET ATSNODE=$ORDER(^DIBT(ATSX,1,ATSNODE))
IF 'ATSNODE
QUIT
SET ATSCNT=ATSCNT+1
IF $DATA(ATSNTSK)
IF '(ATSCNT#50)
WRITE "."
+2 ;QUIT IF NO ZERO NODE IHS/OKCAO/POC 1/17/00
IF '$DATA(^DIBT(ATSX,0))
QUIT
+3 IF $PIECE(^DIBT(ATSX,0),U,1)="RPMS DEMO PATIENT NAMES"
QUIT
+4 IF $PIECE($GET(^BGPSITE(DUZ(2),0)),U,12)=ATSX
QUIT
+5 SET ATSNODE=^DIBT(ATSX,0)
+6 SET ATSDUZ=$PIECE(ATSNODE,U,5)
IF 'ATSDUZ!(ATSDUZ="@")!('$ORDER(^VA(200,ATSDUZ)))
GOTO A
+7 SET ATSNAME=$PIECE(ATSNODE,U)
+8 SET ATSFILEN=$PIECE(ATSNODE,U,4)
SET ATSFILE=$SELECT('ATSFILEN:"FILE NAME UNKNOWN",1:$PIECE(^DIC(ATSFILEN,0),U))
IF 'ATSFILEN
SET ATSFILEN="FILE NUMBER UNKNOWN"
+9 SET Y=$PIECE(ATSNODE,U,2)
IF Y]""
XECUTE ^DD("DD")
SET ATSDATE=$SELECT(Y]"":Y,1:"NO DATE INDICATED")
+10 SET ^UTILITY("ATSMANAGE",$JOB,ATSDUZ,ATSNAME,ATSFILE,ATSFILEN,ATSDATE,ATSCNT)=""
+11 ;NOW KNOW THERE IS MAIL TO SEND
SET ATSENDML=""
+12 DO SEARCH
A QUIT
+1 ;
SEARCH ;ENTER TEMPLATES INTO SEARCH TEMPLATE FILE
+1 SET X="`"_ATSX
SET DIC(0)="FML"
SET DIC="^ATSMNG("
SET DLAYGO=9002220
SET DIADD=1
SET DIC("DR")=".03///"_ATSDUZ
DO ^DIC
KILL DIC,DLAYGO,DIADD
+2 QUIT
+3 ;
MAIL ;SEND MAIL MESSAGES TO USERS RE:TEMPLATES
+1 SET XMDUZ=.5
SET XMTEXT="ATSMAIL("
+2 SET XMSUB="*** NOTICE OF SEARCH TEMPLATE(S) DELETION ***"
+3 SET ATSMAIL(1,0)="THE FOLLOWING SEARCH TEMPLATE(S) WILL BE DELETED IN 60 DAYS UNLESS YOU INDICATE"
SET ATSMAIL(2,0)="OTHERWISE WITHIN THE SAVE SEARCH TEMPLATE OPTION EITHER ON THE SEARCH TEMPLATE"
+4 SET ATSMAIL(3,0)="SYSTEM MENU OR ON ANOTHER MENU YOU HAVE ACCESS TO. CONTACT YOUR SITE MANAGER"
SET ATSMAIL(4,0)="IF YOU HAVE ANY QUESTIONS."
SET ATSMAIL(5,0)=" "
+5 SET (ATSDUZ,ATSNAME)=0
+6 FOR L=0:0
SET ATSDUZ=$ORDER(^UTILITY("ATSMANAGE",$JOB,ATSDUZ))
IF 'ATSDUZ
QUIT
SET ATSUB=5
DO MAILVAR
DO SENDMSG
+7 QUIT
+8 ;
MAILVAR ;SET UP VARIABLES FOR MAIL MESSAGE
+1 FOR L=0:0
SET ATSNAME=$ORDER(^UTILITY("ATSMANAGE",$JOB,ATSDUZ,ATSNAME))
IF ATSNAME=""
QUIT
SET ATSFILE=$ORDER(^(ATSNAME,""))
SET ATSFILEN=$ORDER(^(ATSFILE,""))
SET ATSDATE=$ORDER(^(ATSFILEN,""))
SET ATSCNT=$ORDER(^(ATSDATE,""))
DO CONTLOOP
+2 QUIT
+3 ;
CONTLOOP ;SET UP MORE VARIABLES FOR MAIL MESSAGE
+1 SET ATSUB=ATSUB+1
SET ATSMAIL(ATSUB,0)="TEMPLATE NAME: "_ATSNAME
+2 SET ATSUB=ATSUB+1
SET ATSMAIL(ATSUB,0)="FILE NAME: "_ATSFILE_" FILE NUMBER: "_ATSFILEN
+3 SET ATSUB=ATSUB+1
SET ATSMAIL(ATSUB,0)="DATE TEMPLATE CREATED: "_ATSDATE
+4 SET ATSUB=ATSUB+1
SET ATSMAIL(ATSUB,0)="NUMBER OF SEARCH TEMPLATE ENTRIES: "_ATSCNT
+5 SET ATSUB=ATSUB+1
SET ATSMAIL(ATSUB,0)=" "
+6 QUIT
+7 ;
SENDMSG ;SENDS MESSAGE TO USER
+1 SET XMY(ATSDUZ)=""
+2 DO ^XMD
+3 KILL ATSMAIL
+4 QUIT
+5 ;
EOJ ;
+1 KILL ATSX,ATSCREEN,ATSDA,ATSDUZ,ATSNAME,ATSFILE,ATSCNT,ATSNODE,ATSDIBT,ATSDATE,ATSENDML,ATSFILN,ATSUB,ATSMAIL,^UTILITY("ATSMANAGE")
+2 QUIT
+3 ;
