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