Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OOPSNDB

OOPSNDB.m

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