178 lines
6.7 KiB
Mathematica
178 lines
6.7 KiB
Mathematica
OOPSNDB ;WISC/LLH-NATIONAL DATABASE ;10/12/99
|
|
;;2.0;ASISTS;;Jun 03, 2002
|
|
;
|
|
N ARR,FIELD,FL,MAN,MSG,VAL,RDATE,OOPDA
|
|
S MAN=1
|
|
I '$D(^XUSEC("OOPS XMIT 2162 DATA",DUZ)) D G EXIT
|
|
. S DIR(0)="FO" W !
|
|
. S DIR("A")="You do NOT have the required Security Key."
|
|
. S DIR("A")=DIR("A")_" Press Enter to continue"
|
|
. D ^DIR K DIR
|
|
; Assure the Queue (Q-ASI) has been defined
|
|
S VAL="Q-ASI.MED.VA.GOV",FIELD=.01,FL="X"
|
|
D FIND^DIC(4.2,"",FIELD,FL,VAL,"","","","","ARR")
|
|
I '$D(ARR("DILIST",1)) D G EXIT
|
|
. S DIR(0)="FO" W !
|
|
. S DIR("A")="Domain not found in the DOMAIN File,"
|
|
. S DIR("A")=DIR("A")_" No Transmission. Press Enter to continue"
|
|
. D ^DIR K DIR
|
|
S DIR(0)="D"
|
|
S DIR("A")="Re-transmit cases for what date "
|
|
S DIR("?",1)="Enter the date of original transmission for cases "
|
|
S DIR("?")="that need to be resent"
|
|
D ^DIR K DIR G:$D(DIRUT) EXIT I Y S RDATE=Y
|
|
S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to Queue Transmission"
|
|
S DIR("?",1)="Enter 'Y' if you want the 2162 data placed in mail"
|
|
S DIR("?")="messages as part of a tasked job."
|
|
D ^DIR K DIR G:$D(DIRUT) EXIT I Y D G EXIT
|
|
. S ZTRTN="EN^OOPSNDB",ZTIO=""
|
|
. S ZTDESC="TRAMSIT NATIONAL DATABASE 2162 DATA"
|
|
. D ^%ZTLOAD
|
|
S DIR(0)="Y"
|
|
S DIR("A")="Transmission NOT queued, OK to continue"
|
|
D ^DIR K DIR I 'Y G EXIT
|
|
S MSG("DIHELP",1)="Processing" W !
|
|
D MSG^DIALOG("WH","","","","MSG")
|
|
EN ; Routine Entry
|
|
N CNT,ERR,ERROR,FAIL,OPMG,OPQ
|
|
K VMSG,INV ; used for data validation of records
|
|
S CTR=1 ; counter for Mail message array
|
|
S (START,END,FAIL)=""
|
|
; Assure the Queue (Q-ASI) has been defined
|
|
S VAL="Q-ASI.MED.VA.GOV",FIELD=.01,FL="X"
|
|
D FIND^DIC(4.2,"",FIELD,FL,VAL,"","","","","ARR")
|
|
I '$D(ARR("DILIST",1)) D G EXIT
|
|
. S ERROR(1)="The Queue Q-ASI.MED.VA.GOV has not been created."
|
|
. S ERROR(2)="Install Patch XM*999*130, complete manual "
|
|
. S ERROR(3)="Transmission of NDB Data."
|
|
. D ERROR
|
|
; Make sure Mail Group Exists
|
|
S OPMG=$$FIND1^DIC(3.8,"","X","OOPS NDB MESSAGES")
|
|
I 'OPMG D G EXIT
|
|
. S ERROR(1)="The Mail Group OOPS NDB MESSAGES is missing."
|
|
. S ERROR(2)="Add the Group so that ASISTS data can be transmitted "
|
|
. S ERROR(3)="to the AAC. Then contact IRM to complete manual "
|
|
. S ERROR(4)="Transmission of NDB Data."
|
|
. D ERROR
|
|
; Get list of members
|
|
D LIST^DIC(3.81,","_OPMG_",","","",1,"","","","","","OPQ")
|
|
I '$P(OPQ("DILIST",0),U) D G EXIT
|
|
. S ERROR(1)="There are no members of the OOPS NDB MESSAGES "
|
|
. S ERROR(1)=ERROR(1)_"Mail Group."
|
|
. S ERROR(2)="Enter at least one member to the group. This person "
|
|
. S ERROR(3)="will receive messages concerning the transmission of "
|
|
. S ERROR(4)="ASISTS NDB data to and from the AAC. After adding member"
|
|
. S ERROR(5)="contact IRM to complete manual transmission of NDB data."
|
|
. D ERROR
|
|
GETREC ; Loop thru ^OOP(2260 "AN" OR "ANC" Xref to get records to transmit
|
|
; The logic for this data retrevial was changed for patch 11 to use
|
|
; the Xrefs vs looping through the entire 2260 file.
|
|
N OOPIEN,PRSCNT,PRSDA,XMDUZ,XMTEXT,XMSUB,XMY,INDEX,INDEX2
|
|
N Y,%,%H,%I
|
|
K ^TMP($J,"C"),^TMP($J,"D")
|
|
S (CNT,PRSCNT,OOPDA)=0
|
|
D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD")
|
|
S MTIME=$P(Y,"@",2),DATE=$$DC^OOPSNDBX(%)
|
|
S OOPIEN=""
|
|
I '$G(MAN) S INDEX="^OOPS(2260,""AN"",OPI)",INDEX2="^OOPS(2260,""AN"",OPI,OOPIEN)"
|
|
E S INDEX="^OOPS(2260,""ANC"",OPI)",INDEX2="^OOPS(2260,""ANC"",OPI,OOPIEN)"
|
|
S OPI=0 F S OPI=$O(@INDEX) Q:'OPI D
|
|
.S OOPIEN=0 F S OOPIEN=$O(@INDEX2) Q:'OOPIEN D
|
|
.. I $G(MAN),OPI'=RDATE Q
|
|
.. S VALID=""
|
|
.. F CHK=5:1:7 I '$$GET1^DIQ(2260,OOPIEN,CHK,"I") S:CHK=5 $P(VALID,U)=5 S:CHK=6 $P(VALID,U,2)=6 S:CHK=7 $P(VALID,U,3)=7
|
|
.. I $G(VALID)'="" S ^TMP($J,"D",OOPIEN)=VALID Q
|
|
.. S ^TMP($J,"C",OOPIEN)=""
|
|
.. S CNT=CNT+1
|
|
S ^TMP($J,"C")=CNT
|
|
; Count # of Non-Separated PAID Employees
|
|
S PRSDA=0 D
|
|
. F S PRSDA=$O(^PRSPC(PRSDA)) Q:PRSDA'>0 D
|
|
.. I $$GET1^DIQ(450,PRSDA,80,"I")'="Y" S PRSCNT=PRSCNT+1
|
|
NOCASES ; No Cases to Send - Send Mail Message with only NDB segment
|
|
I CNT=0 D G EXIT
|
|
. D CREATE Q:FAIL
|
|
. D SEND
|
|
PROCESS ;
|
|
D CREATE G:FAIL EXIT
|
|
; START - First case number in MM, End - Last Case # in MM
|
|
S OOPDA="",START="",END="",OPAST=""
|
|
F S OPAST=OOPDA,OOPDA=$O(^TMP($J,"C",OOPDA)) Q:OOPDA="" D
|
|
. D ^OOPSNDBX
|
|
. ; Set DATE TRANSMITTED TO NDB in ^OOPS(2260 records
|
|
. I $$GET1^DIQ(2260,OOPDA,57)="" D
|
|
.. K DR S DIE="^OOPS(2260,",(IEN,DA)=OOPDA,DR="57///TODAY" D ^DIE K DR,DA,DIE
|
|
; If any records left to send and no FAILure
|
|
I ($G(XMZ)'<1)&('FAIL) D
|
|
. I END="" S END=$P($P(^OOPS(2260,OPAST,0),U),"-",2)
|
|
. D SEND
|
|
;
|
|
EXIT ; Quits the program
|
|
D BADREC ; Send Mail if any Bad Records
|
|
I $G(FAIL) D
|
|
. S ERROR(1)="Mail Message was not created. Contact IRM to comlete "
|
|
. S ERROR(2)="the manual transmission of ASISTS NDB data."
|
|
. D ERROR
|
|
K CTR,DATE,ERR,ERROR,GRP,INV,OPL,MSIZE,MTIME,XMSUB,XMTEXT,XMY,MSG
|
|
K ^TMP($J)
|
|
Q
|
|
CREATE ; Create MailMan Message
|
|
N OPDATA,SN
|
|
S MSIZE=0
|
|
I $G(XMZ)'<1 D SEND
|
|
S OPL=0
|
|
S XMSUB="ASISTS NATIONAL DATABASE"
|
|
S XMDUZ=DUZ
|
|
D XMZ^XMA2 I XMZ<1 S FAIL=1 Q
|
|
S SN=$$GET1^DIQ(4,$P($G(^XMB(1,1,"XUS")),U,17),99)
|
|
S SN=$E("0000000",$L(SN)+1,7)_SN
|
|
S OPDATA="NDB^OOPS^"_SN_U_DATE_U_MTIME_U_^TMP($J,"C")
|
|
S OPDATA=OPDATA_U_U_PRSCNT_U_"002"_U_"|" ; chg 001 to 002 as ver 2
|
|
S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)=OPDATA
|
|
Q
|
|
SEND ; Send MailMan Message
|
|
N NUMCASE
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_OPL_U_OPL_U_DT
|
|
; Set # of Cases in this Mail Message
|
|
S NUMCASE=$S(START'="":START_"-"_END,1:0)
|
|
S $P(^XMB(3.9,XMZ,2,1,0),U,7)=NUMCASE
|
|
; Indicate last line of message
|
|
S OPL=OPL+1,^XMB(3.9,XMZ,2,OPL,0)="$"
|
|
S XMY(DUZ)="" ; also send here, in case of error.
|
|
S XMY("XXX@Q-ASI.MED.VA.GOV")=""
|
|
S XMCHAN=1 D ENT1^XMD K XMCHAN
|
|
K XMZ
|
|
Q
|
|
BADREC ; If any records with missing data, send mail message
|
|
K MSG
|
|
S CTR=1,OOPDA=0
|
|
F S OOPDA=$O(^TMP($J,"D",OOPDA)) Q:OOPDA="" D
|
|
. S VALID=^TMP($J,"D",OOPDA)
|
|
. S MSG(CTR)="Case: "_$$GET1^DIQ(2260,OOPDA,.01)_" has missing data "
|
|
. S MSG(CTR)=MSG(CTR)_"that must be entered prior",CTR=CTR+1
|
|
. S MSG(CTR)="to transmitting to AAC. ",CTR=CTR+1
|
|
. I $P(VALID,U) S MSG(CTR)=" Missing SSN",CTR=CTR+1
|
|
. I $P(VALID,U,2) S MSG(CTR)=" Missing DOB",CTR=CTR+1
|
|
. I $P(VALID,U,3) S MSG(CTR)=" Missing SEX",CTR=CTR+1
|
|
I $D(MSG) D
|
|
. S XMSUB="ASISTS Records Missing Necessary Data Elements"
|
|
. S XMY("G.OOPS NDB MESSAGES@"_^XMB("NETNAME"))=""
|
|
. S XMTEXT="MSG("
|
|
. D ^XMD
|
|
Q
|
|
ERROR ; Create appropriate Error message and Send message
|
|
S XMDUZ="ASISTS Package"
|
|
S GRP="OOPS SAFETY"
|
|
D GRP^OOPSMBUL
|
|
; If no one in mail group (this should not occur), send to user
|
|
I $D(XMY)<9 S XMY(DUZ)=""
|
|
S XMSUB="ASISTS NDB Error Notification Message"
|
|
S XMTEXT="ERROR("
|
|
D ^XMD
|
|
I '$D(ZTQUEUED) D
|
|
. S MSG("DIHELP",1)="An Error Occurred during Processing, check"
|
|
. S MSG("DIHELP",2)="Mailman Message for details."
|
|
. D MSG^DIALOG("WH","","","","MSG")
|
|
K ERROR
|
|
Q
|