- 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 ;
