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

XUPSPAID.m

Go to the documentation of this file.
  1. XUPSPAID ;CS/GRR/RAM/DW - New Person file Update & Report ; 1 Jan 2004
  1. ;;8.0;KERNEL;**309,343**; Jul 10, 1995;
  1. ;
  1. Q
  1. ;
  1. EN ; - entry point
  1. ;
  1. N DIRUT,X,Y
  1. ;
  1. I $E(XUPSACT,1)="U" D
  1. . W !!," *********************************************"
  1. . W !," *This option will UPDATE eligible New Person*"
  1. . W !," *file (#200) entries with missing DOB or SEX*"
  1. . W !," *********************************************"
  1. ;
  1. W !!,"The reports will be sent to you via MailMan",!
  1. ;
  1. S DIR(0)="YA",DIR("B")="Yes",DIR("A")="Do you wish to continue? "
  1. S DIR("?")="Enter 'Yes' to continue or 'No' to quit"
  1. D ^DIR K DIR ;ask user if they want to continue with option
  1. Q:'Y!($D(DIRUT)) ;user responded No or with '^' to exit
  1. ;
  1. D QUE
  1. ;
  1. K XUPSACT
  1. Q
  1. ;
  1. QUE ;Que the task
  1. N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
  1. W !
  1. S ZTIO=""
  1. S ZTRTN="EN1^XUPSPAID"
  1. S ZTSAVE("XUPSACT")=""
  1. I $E(XUPSACT,1)="U" S ZTDESC="XUPS NPF UPDATE"
  1. I $E(XUPSACT,1)="P" S ZTDESC="XUPS NPF PREUPDATE REPORT"
  1. D ^%ZTLOAD
  1. D ^%ZISC,HOME^%ZIS
  1. W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
  1. ;
  1. Q
  1. ;
  1. EN1 ;
  1. N IEN,XUPSDIFF,XUPSUPD,XUT,XUNPFT,XUUPDT
  1. S (XUNPFT,XUUPDT)=0
  1. ;
  1. K ^TMP("XUPS PAID",$J)
  1. K ^TMP("XUPS DIFF",$J)
  1. K ^TMP("XUPS UPD",$J)
  1. ;
  1. S XUPSDIFF("SSN")=0
  1. S XUPSDIFF("NAME")=0
  1. S XUPSDIFF("SEX")=0
  1. S XUPSDIFF("DOB")=0
  1. ;
  1. S XUPSUPD("SEX")=0
  1. S XUPSUPD("DOB")=0
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^PRSPC(IEN)) Q:'IEN D RECORD
  1. ;
  1. S XUT(1)=$G(XUNPFT)
  1. S XUT(2)=$G(XUUPDT)
  1. I $E(XUPSACT,1)="U" D NOTICE^XUPSPD1(.XUT)
  1. ;
  1. D REPORT
  1. ;
  1. Q
  1. ;
  1. REPORT ;Pre-update reports
  1. ;
  1. N CNTG,DATA,DATA1,IEN,CNT,CNTU,CNTD
  1. S (CNTG,CNT,CNTU,CNTD)=0
  1. ;
  1. ;The difference report
  1. D HD("XUPS DIFF")
  1. S IEN=0
  1. F S IEN=$O(^TMP("XUPS PAID",$J,"DIFF",IEN)) Q:'IEN D
  1. .S DATA=^TMP("XUPS PAID",$J,"DIFF",IEN)
  1. .D FL("XUPS DIFF",DATA)
  1. .S CNTD=$G(CNTD)+1
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS DIFF",$J,CNT)=""
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS DIFF",$J,CNT)=" Totals"
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS DIFF",$J,CNT)=" Different LastName,FirstName: "_$G(XUPSDIFF("NAME"))
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS DIFF",$J,CNT)=" Same LastName,FirstName, different Sex: "_$G(XUPSDIFF("SEX"))
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS DIFF",$J,CNT)=" Same LastName,FirstName, different DOB: "_$G(XUPSDIFF("DOB"))
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS DIFF",$J,CNT)=" New Person file entries: "_$G(CNTD)
  1. ;
  1. ;The update report
  1. S CNT=0
  1. D HD1("XUPS UPD")
  1. S IEN=0
  1. F S IEN=$O(^TMP("XUPS PAID",$J,"UPD",IEN)) Q:'IEN D
  1. .S DATA=^TMP("XUPS PAID",$J,"UPD",IEN)
  1. .D FL1("XUPS UPD",DATA)
  1. .S CNTU=$G(CNTU)+1
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS UPD",$J,CNT)=""
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS UPD",$J,CNT)=" Totals"
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS UPD",$J,CNT)=" Sex fields: "_XUPSUPD("SEX")
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS UPD",$J,CNT)=" DOB fields: "_XUPSUPD("DOB")
  1. S CNT=$G(CNT)+1
  1. S ^TMP("XUPS UPD",$J,CNT)=" New Person entries: "_$G(CNTU)
  1. ;
  1. D XM("Update NPF with PAID data - Sex and DOB","XUPS UPD")
  1. D XM("Differences between NPF and PAID files","XUPS DIFF")
  1. ;
  1. K ^TMP("XUPS PAID",$J)
  1. K ^TMP("XUPS DIFF",$J)
  1. K ^TMP("XUPS UPD",$J)
  1. ;
  1. Q
  1. ;
  1. RECORD ;Process the record
  1. ;
  1. N IEN200,DATA,DATA1
  1. N PAIDNM,PAIDOB,PAIDSSN,PAIDSEX
  1. N NPFNM,NPFSEX,NPFDOB,NPFSSN
  1. ;
  1. ; NPF IEN
  1. S IEN200=$P($G(^PRSPC(IEN,200)),"^",1)
  1. ;
  1. Q:'IEN200
  1. S XUNPFT=$G(XUNPFT)+1
  1. ;
  1. ; PAID file
  1. S DATA=$G(^PRSPC(IEN,0))
  1. S PAIDNM=$P(DATA,"^",1)
  1. S PAIDDOB=$P(DATA,"^",33)
  1. S PAIDSSN=$P(DATA,"^",9)
  1. S PAIDSEX=$P(DATA,"^",32)
  1. ; transform SEX code PAID to NPF
  1. S PAIDSEX=$S(PAIDSEX="":"",PAIDSEX=1:"M",PAIDSEX=2:"F",1:"")
  1. ;
  1. ; New Person File
  1. S DATA=$G(^VA(200,IEN200,1))
  1. S NPFNM=$P($G(^VA(200,IEN200,0)),U)
  1. S NPFSEX=$P(DATA,"^",2)
  1. S NPFDOB=$P(DATA,"^",3)
  1. S NPFSSN=$P(DATA,"^",9)
  1. ;
  1. Q:NPFSSN'=PAIDSSN
  1. ;
  1. S DATA=NPFNM_U_NPFSEX_U_NPFDOB_U_NPFSSN
  1. S DATA=DATA_U_PAIDNM_U_PAIDSEX_U_PAIDDOB_U_PAIDSSN_U_IEN200
  1. ;
  1. S DATA1=NPFSSN_U_NPFNM_U_U_U_IEN200
  1. ;
  1. I $$NAME(NPFNM)'=$$NAME(PAIDNM) D Q
  1. .S XUPSDIFF("NAME")=XUPSDIFF("NAME")+1
  1. .S ^TMP("XUPS PAID",$J,"DIFF",IEN200)=DATA
  1. ;
  1. I PAIDSEX'="" D
  1. .I NPFSEX="" D Q
  1. ..S $P(DATA1,U,3)=PAIDSEX
  1. ..S XUPSUPD("SEX")=XUPSUPD("SEX")+1
  1. ..S ^TMP("XUPS PAID",$J,"UPD",IEN200)=DATA1
  1. ..I $E(XUPSACT,1)="U" D
  1. ... D UPDSEX
  1. ... S XUUPDT=$G(XUUPDT)+1
  1. .I NPFSEX'=PAIDSEX D Q
  1. ..S XUPSDIFF("SEX")=XUPSDIFF("SEX")+1
  1. ..S ^TMP("XUPS PAID",$J,"DIFF",IEN200)=DATA
  1. ;
  1. I PAIDDOB'="" D
  1. .I NPFDOB="" D Q
  1. ..S $P(DATA1,U,4)=PAIDDOB
  1. ..S XUPSUPD("DOB")=XUPSUPD("DOB")+1
  1. ..S ^TMP("XUPS PAID",$J,"UPD",IEN200)=DATA1
  1. ..I $E(XUPSACT,1)="U" D
  1. ... D UPDDOB
  1. ... S XUUPDT=$G(XUUPDT)+1
  1. .I NPFDOB'=PAIDDOB D Q
  1. ..S XUPSDIFF("DOB")=XUPSDIFF("DOB")+1
  1. ..S ^TMP("XUPS PAID",$J,"DIFF",IEN200)=DATA
  1. ;
  1. Q
  1. ;
  1. HD(NODE) ; -- Report header
  1. N C1,C2,C3,C4,C5
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. I NODE="XUPS DIFF" D
  1. . S CNT=$G(CNT)+1
  1. . S ^TMP(NODE,$J,CNT)="The following New Person File entries have different LastName,FirstName,"
  1. . S CNT=$G(CNT)+1
  1. . S ^TMP(NODE,$J,CNT)="or same LastName,FirstName but different Sex or DOB with their linked PAID"
  1. . S CNT=$G(CNT)+1
  1. . S ^TMP(NODE,$J,CNT)="Employee entries."
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. S C1=$$LJ^XLFSTR("NPF - Name",30," ")
  1. S C2=$$CJ^XLFSTR("SEX",3," ")
  1. S C3=$$LJ^XLFSTR("DOB",11," ")
  1. S C4=$$LJ^XLFSTR("SSN",9," ")
  1. S C5=$$RJ^XLFSTR("IEN",14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S C1=$$LJ^XLFSTR("PAID -",30," ")
  1. S C2=$$CJ^XLFSTR("",3," ")
  1. S C3=$$LJ^XLFSTR("",11," ")
  1. S C4=$$LJ^XLFSTR("",9," ")
  1. S C5=$$RJ^XLFSTR("",14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S C1=$$LJ^XLFSTR("=================",30," ")
  1. S C2=$$CJ^XLFSTR("===",3," ")
  1. S C3=$$LJ^XLFSTR("==========",11," ")
  1. S C4=$$LJ^XLFSTR("=========",9," ")
  1. S C5=$$RJ^XLFSTR("===",14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. Q
  1. ;
  1. FL(NODE,DATA) ; -- format line
  1. ;
  1. N NPFNM,NPFSEX,NPFDOB,NPFSSN,NPFIEN
  1. N PAIDNM,PAIDSEX,PAIDDOB,PAIDSSN
  1. ;
  1. S NPFNM=$P(DATA,U,1)
  1. S NPFSEX=$P(DATA,U,2)
  1. S NPFDOB=$P(DATA,U,3)
  1. S NPFSSN=$P(DATA,U,4)
  1. S NPFIEN=$P(DATA,U,9)
  1. S PAIDNM=$P(DATA,U,5)
  1. S PAIDSEX=$P(DATA,U,6)
  1. S PAIDDOB=$P(DATA,U,7)
  1. S PAIDSSN=$P(DATA,U,8)
  1. ;
  1. N C1,C2,C3,C4,C5
  1. ;
  1. ;NPF values
  1. S C1=$$LJ^XLFSTR(NPFNM,30," ")
  1. S C2=$$CJ^XLFSTR(NPFSEX,3," ")
  1. S C3=$$LJ^XLFSTR($$DOB(NPFDOB),11," ")
  1. S C4=$$LJ^XLFSTR(NPFSSN,9," ")
  1. S C5=$$RJ^XLFSTR(NPFIEN,14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. ;PAID values
  1. S C1=$$LJ^XLFSTR(PAIDNM,30," ")
  1. S C2=$$CJ^XLFSTR(PAIDSEX,3," ")
  1. S C3=$$LJ^XLFSTR($$DOB(PAIDDOB),11," ")
  1. S C4=$$LJ^XLFSTR(PAIDSSN,9," ")
  1. S C5=$$RJ^XLFSTR(" ",14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. Q
  1. ;
  1. HD1(NODE) ; -- Report header
  1. ;
  1. N C1,C2,C3,C4,C5
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. I NODE="XUPS UPD" D
  1. . S CNT=$G(CNT)+1
  1. . S ^TMP(NODE,$J,CNT)="The following New Person File entries will be updated."
  1. . S CNT=$G(CNT)+1
  1. . S ^TMP(NODE,$J,CNT)="The DOB or Sex fields to be updated are shown with the PAID values;"
  1. . S CNT=$G(CNT)+1
  1. . S ^TMP(NODE,$J,CNT)="The DOB or Sex fields not to be updated are shown with ""-""."
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. S C1=$$LJ^XLFSTR("SSN",9," ")
  1. S C2=$$LJ^XLFSTR("NPF Name",30," ")
  1. S C3=$$LJ^XLFSTR("SEX",3," ")
  1. S C4=$$LJ^XLFSTR("DOB",11," ")
  1. S C5=$$RJ^XLFSTR("IEN",14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S C1=$$LJ^XLFSTR("=========",9," ")
  1. S C2=$$LJ^XLFSTR("=================",30," ")
  1. S C3=$$CJ^XLFSTR("===",3," ")
  1. S C4=$$LJ^XLFSTR("==========",11," ")
  1. S C5=$$RJ^XLFSTR("===",14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. Q
  1. ;
  1. FL1(NODE,DATA) ; -- format line
  1. ;
  1. N NPFSSN,NPFNM,NPFSEX,NPFDOB,NPFIEN
  1. ;
  1. S NPFSSN=$P(DATA,U,1)
  1. S NPFNM=$P(DATA,U,2)
  1. S NPFSEX=$P(DATA,U,3)
  1. I NPFSEX="" S NPFSEX="-"
  1. S NPFDOB=$P(DATA,U,4)
  1. S NPFIEN=$P(DATA,U,5)
  1. ;
  1. N C1,C2,C3,C4,C5
  1. ;
  1. ;NPF values
  1. S C1=$$LJ^XLFSTR(NPFSSN,9," ")
  1. S C2=$$LJ^XLFSTR(NPFNM,30," ")
  1. S C3=$$CJ^XLFSTR(NPFSEX,3," ")
  1. I NPFDOB="" S C4="---------- "
  1. I NPFDOB'="" S C4=$$LJ^XLFSTR($$DOB(NPFDOB),11," ")
  1. S C5=$$RJ^XLFSTR(NPFIEN,14," ")
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
  1. ;
  1. S CNT=$G(CNT)+1
  1. S ^TMP(NODE,$J,CNT)=""
  1. ;
  1. Q
  1. ;
  1. UPDSEX ;Update SEX if NPF SEX is null
  1. I $E(XUPSACT,1)'="U" Q
  1. ;
  1. N DIE,DA,DR
  1. S DIE=200,DA=IEN200
  1. I NPFSEX="" D
  1. . S DR="4///^S X=PAIDSEX"
  1. . D ^DIE
  1. Q
  1. ;
  1. UPDDOB ;Update DOB if NPF DOB is null
  1. I $E(XUPSACT,1)'="U" Q
  1. ;
  1. N DIE,DA,DR
  1. S DIE=200,DA=IEN200
  1. I NPFDOB="" D
  1. . S DR="5///^S X=PAIDDOB"
  1. . D ^DIE
  1. Q
  1. ;
  1. NAME(NAME) ; Return "LastName,FirstName".
  1. ;
  1. N RESULT,STDNM
  1. ;
  1. S RESULT=""
  1. ;
  1. ; CALL FORMAT^XLFNAME7
  1. S STDNM=$$FORMAT^XLFNAME7(.NAME,3,35)
  1. ;
  1. ; Return LastName,FirstName
  1. S RESULT=$P($G(STDNM)," ",1)
  1. ;
  1. Q RESULT
  1. ;
  1. DOB(DOB) ; format DOB
  1. ;
  1. Q:DOB="" ""
  1. ;
  1. Q $E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_(1700+$E(DOB,1,3))
  1. ;
  1. PSDT() ; format date
  1. ;
  1. N %
  1. ;
  1. D NOW^%DTC S Y=% D DD^%DT
  1. ;
  1. Q Y
  1. ;
  1. XM(XMSUB,X) ;Email the report
  1. ;If called within a task, protect variables
  1. I $D(ZTQUEUED) N %,DIFROM
  1. ;
  1. N XMY,XMTEXT,XMDUZ
  1. S XMY(DUZ)="",XMDUZ=.5
  1. S XMTEXT="^TMP("""_X_""",$J,"
  1. D ^XMD
  1. ;
  1. Q
  1. ;