- XUPSPAID ;CS/GRR/RAM/DW - New Person file Update & Report ; 1 Jan 2004
- ;;8.0;KERNEL;**309,343**; Jul 10, 1995;
- ;
- Q
- ;
- EN ; - entry point
- ;
- N DIRUT,X,Y
- ;
- I $E(XUPSACT,1)="U" D
- . W !!," *********************************************"
- . W !," *This option will UPDATE eligible New Person*"
- . W !," *file (#200) entries with missing DOB or SEX*"
- . W !," *********************************************"
- ;
- W !!,"The reports will be sent to you via MailMan",!
- ;
- S DIR(0)="YA",DIR("B")="Yes",DIR("A")="Do you wish to continue? "
- S DIR("?")="Enter 'Yes' to continue or 'No' to quit"
- D ^DIR K DIR ;ask user if they want to continue with option
- Q:'Y!($D(DIRUT)) ;user responded No or with '^' to exit
- ;
- D QUE
- ;
- K XUPSACT
- Q
- ;
- QUE ;Que the task
- N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
- W !
- S ZTIO=""
- S ZTRTN="EN1^XUPSPAID"
- S ZTSAVE("XUPSACT")=""
- I $E(XUPSACT,1)="U" S ZTDESC="XUPS NPF UPDATE"
- I $E(XUPSACT,1)="P" S ZTDESC="XUPS NPF PREUPDATE REPORT"
- D ^%ZTLOAD
- D ^%ZISC,HOME^%ZIS
- W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
- ;
- Q
- ;
- EN1 ;
- N IEN,XUPSDIFF,XUPSUPD,XUT,XUNPFT,XUUPDT
- S (XUNPFT,XUUPDT)=0
- ;
- K ^TMP("XUPS PAID",$J)
- K ^TMP("XUPS DIFF",$J)
- K ^TMP("XUPS UPD",$J)
- ;
- S XUPSDIFF("SSN")=0
- S XUPSDIFF("NAME")=0
- S XUPSDIFF("SEX")=0
- S XUPSDIFF("DOB")=0
- ;
- S XUPSUPD("SEX")=0
- S XUPSUPD("DOB")=0
- ;
- S IEN=0
- F S IEN=$O(^PRSPC(IEN)) Q:'IEN D RECORD
- ;
- S XUT(1)=$G(XUNPFT)
- S XUT(2)=$G(XUUPDT)
- I $E(XUPSACT,1)="U" D NOTICE^XUPSPD1(.XUT)
- ;
- D REPORT
- ;
- Q
- ;
- REPORT ;Pre-update reports
- ;
- N CNTG,DATA,DATA1,IEN,CNT,CNTU,CNTD
- S (CNTG,CNT,CNTU,CNTD)=0
- ;
- ;The difference report
- D HD("XUPS DIFF")
- S IEN=0
- F S IEN=$O(^TMP("XUPS PAID",$J,"DIFF",IEN)) Q:'IEN D
- .S DATA=^TMP("XUPS PAID",$J,"DIFF",IEN)
- .D FL("XUPS DIFF",DATA)
- .S CNTD=$G(CNTD)+1
- S CNT=$G(CNT)+1
- S ^TMP("XUPS DIFF",$J,CNT)=""
- S CNT=$G(CNT)+1
- S ^TMP("XUPS DIFF",$J,CNT)=" Totals"
- S CNT=$G(CNT)+1
- S ^TMP("XUPS DIFF",$J,CNT)=" Different LastName,FirstName: "_$G(XUPSDIFF("NAME"))
- S CNT=$G(CNT)+1
- S ^TMP("XUPS DIFF",$J,CNT)=" Same LastName,FirstName, different Sex: "_$G(XUPSDIFF("SEX"))
- S CNT=$G(CNT)+1
- S ^TMP("XUPS DIFF",$J,CNT)=" Same LastName,FirstName, different DOB: "_$G(XUPSDIFF("DOB"))
- S CNT=$G(CNT)+1
- S ^TMP("XUPS DIFF",$J,CNT)=" New Person file entries: "_$G(CNTD)
- ;
- ;The update report
- S CNT=0
- D HD1("XUPS UPD")
- S IEN=0
- F S IEN=$O(^TMP("XUPS PAID",$J,"UPD",IEN)) Q:'IEN D
- .S DATA=^TMP("XUPS PAID",$J,"UPD",IEN)
- .D FL1("XUPS UPD",DATA)
- .S CNTU=$G(CNTU)+1
- S CNT=$G(CNT)+1
- S ^TMP("XUPS UPD",$J,CNT)=""
- S CNT=$G(CNT)+1
- S ^TMP("XUPS UPD",$J,CNT)=" Totals"
- S CNT=$G(CNT)+1
- S ^TMP("XUPS UPD",$J,CNT)=" Sex fields: "_XUPSUPD("SEX")
- S CNT=$G(CNT)+1
- S ^TMP("XUPS UPD",$J,CNT)=" DOB fields: "_XUPSUPD("DOB")
- S CNT=$G(CNT)+1
- S ^TMP("XUPS UPD",$J,CNT)=" New Person entries: "_$G(CNTU)
- ;
- D XM("Update NPF with PAID data - Sex and DOB","XUPS UPD")
- D XM("Differences between NPF and PAID files","XUPS DIFF")
- ;
- K ^TMP("XUPS PAID",$J)
- K ^TMP("XUPS DIFF",$J)
- K ^TMP("XUPS UPD",$J)
- ;
- Q
- ;
- RECORD ;Process the record
- ;
- N IEN200,DATA,DATA1
- N PAIDNM,PAIDOB,PAIDSSN,PAIDSEX
- N NPFNM,NPFSEX,NPFDOB,NPFSSN
- ;
- ; NPF IEN
- S IEN200=$P($G(^PRSPC(IEN,200)),"^",1)
- ;
- Q:'IEN200
- S XUNPFT=$G(XUNPFT)+1
- ;
- ; PAID file
- S DATA=$G(^PRSPC(IEN,0))
- S PAIDNM=$P(DATA,"^",1)
- S PAIDDOB=$P(DATA,"^",33)
- S PAIDSSN=$P(DATA,"^",9)
- S PAIDSEX=$P(DATA,"^",32)
- ; transform SEX code PAID to NPF
- S PAIDSEX=$S(PAIDSEX="":"",PAIDSEX=1:"M",PAIDSEX=2:"F",1:"")
- ;
- ; New Person File
- S DATA=$G(^VA(200,IEN200,1))
- S NPFNM=$P($G(^VA(200,IEN200,0)),U)
- S NPFSEX=$P(DATA,"^",2)
- S NPFDOB=$P(DATA,"^",3)
- S NPFSSN=$P(DATA,"^",9)
- ;
- Q:NPFSSN'=PAIDSSN
- ;
- S DATA=NPFNM_U_NPFSEX_U_NPFDOB_U_NPFSSN
- S DATA=DATA_U_PAIDNM_U_PAIDSEX_U_PAIDDOB_U_PAIDSSN_U_IEN200
- ;
- S DATA1=NPFSSN_U_NPFNM_U_U_U_IEN200
- ;
- I $$NAME(NPFNM)'=$$NAME(PAIDNM) D Q
- .S XUPSDIFF("NAME")=XUPSDIFF("NAME")+1
- .S ^TMP("XUPS PAID",$J,"DIFF",IEN200)=DATA
- ;
- I PAIDSEX'="" D
- .I NPFSEX="" D Q
- ..S $P(DATA1,U,3)=PAIDSEX
- ..S XUPSUPD("SEX")=XUPSUPD("SEX")+1
- ..S ^TMP("XUPS PAID",$J,"UPD",IEN200)=DATA1
- ..I $E(XUPSACT,1)="U" D
- ... D UPDSEX
- ... S XUUPDT=$G(XUUPDT)+1
- .I NPFSEX'=PAIDSEX D Q
- ..S XUPSDIFF("SEX")=XUPSDIFF("SEX")+1
- ..S ^TMP("XUPS PAID",$J,"DIFF",IEN200)=DATA
- ;
- I PAIDDOB'="" D
- .I NPFDOB="" D Q
- ..S $P(DATA1,U,4)=PAIDDOB
- ..S XUPSUPD("DOB")=XUPSUPD("DOB")+1
- ..S ^TMP("XUPS PAID",$J,"UPD",IEN200)=DATA1
- ..I $E(XUPSACT,1)="U" D
- ... D UPDDOB
- ... S XUUPDT=$G(XUUPDT)+1
- .I NPFDOB'=PAIDDOB D Q
- ..S XUPSDIFF("DOB")=XUPSDIFF("DOB")+1
- ..S ^TMP("XUPS PAID",$J,"DIFF",IEN200)=DATA
- ;
- Q
- ;
- HD(NODE) ; -- Report header
- N C1,C2,C3,C4,C5
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- I NODE="XUPS DIFF" D
- . S CNT=$G(CNT)+1
- . S ^TMP(NODE,$J,CNT)="The following New Person File entries have different LastName,FirstName,"
- . S CNT=$G(CNT)+1
- . S ^TMP(NODE,$J,CNT)="or same LastName,FirstName but different Sex or DOB with their linked PAID"
- . S CNT=$G(CNT)+1
- . S ^TMP(NODE,$J,CNT)="Employee entries."
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- S C1=$$LJ^XLFSTR("NPF - Name",30," ")
- S C2=$$CJ^XLFSTR("SEX",3," ")
- S C3=$$LJ^XLFSTR("DOB",11," ")
- S C4=$$LJ^XLFSTR("SSN",9," ")
- S C5=$$RJ^XLFSTR("IEN",14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- ;
- S C1=$$LJ^XLFSTR("PAID -",30," ")
- S C2=$$CJ^XLFSTR("",3," ")
- S C3=$$LJ^XLFSTR("",11," ")
- S C4=$$LJ^XLFSTR("",9," ")
- S C5=$$RJ^XLFSTR("",14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- ;
- S C1=$$LJ^XLFSTR("=================",30," ")
- S C2=$$CJ^XLFSTR("===",3," ")
- S C3=$$LJ^XLFSTR("==========",11," ")
- S C4=$$LJ^XLFSTR("=========",9," ")
- S C5=$$RJ^XLFSTR("===",14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- Q
- ;
- FL(NODE,DATA) ; -- format line
- ;
- N NPFNM,NPFSEX,NPFDOB,NPFSSN,NPFIEN
- N PAIDNM,PAIDSEX,PAIDDOB,PAIDSSN
- ;
- S NPFNM=$P(DATA,U,1)
- S NPFSEX=$P(DATA,U,2)
- S NPFDOB=$P(DATA,U,3)
- S NPFSSN=$P(DATA,U,4)
- S NPFIEN=$P(DATA,U,9)
- S PAIDNM=$P(DATA,U,5)
- S PAIDSEX=$P(DATA,U,6)
- S PAIDDOB=$P(DATA,U,7)
- S PAIDSSN=$P(DATA,U,8)
- ;
- N C1,C2,C3,C4,C5
- ;
- ;NPF values
- S C1=$$LJ^XLFSTR(NPFNM,30," ")
- S C2=$$CJ^XLFSTR(NPFSEX,3," ")
- S C3=$$LJ^XLFSTR($$DOB(NPFDOB),11," ")
- S C4=$$LJ^XLFSTR(NPFSSN,9," ")
- S C5=$$RJ^XLFSTR(NPFIEN,14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- ;
- ;PAID values
- S C1=$$LJ^XLFSTR(PAIDNM,30," ")
- S C2=$$CJ^XLFSTR(PAIDSEX,3," ")
- S C3=$$LJ^XLFSTR($$DOB(PAIDDOB),11," ")
- S C4=$$LJ^XLFSTR(PAIDSSN,9," ")
- S C5=$$RJ^XLFSTR(" ",14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- Q
- ;
- HD1(NODE) ; -- Report header
- ;
- N C1,C2,C3,C4,C5
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- I NODE="XUPS UPD" D
- . S CNT=$G(CNT)+1
- . S ^TMP(NODE,$J,CNT)="The following New Person File entries will be updated."
- . S CNT=$G(CNT)+1
- . S ^TMP(NODE,$J,CNT)="The DOB or Sex fields to be updated are shown with the PAID values;"
- . S CNT=$G(CNT)+1
- . S ^TMP(NODE,$J,CNT)="The DOB or Sex fields not to be updated are shown with ""-""."
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- S C1=$$LJ^XLFSTR("SSN",9," ")
- S C2=$$LJ^XLFSTR("NPF Name",30," ")
- S C3=$$LJ^XLFSTR("SEX",3," ")
- S C4=$$LJ^XLFSTR("DOB",11," ")
- S C5=$$RJ^XLFSTR("IEN",14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
- ;
- S C1=$$LJ^XLFSTR("=========",9," ")
- S C2=$$LJ^XLFSTR("=================",30," ")
- S C3=$$CJ^XLFSTR("===",3," ")
- S C4=$$LJ^XLFSTR("==========",11," ")
- S C5=$$RJ^XLFSTR("===",14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- Q
- ;
- FL1(NODE,DATA) ; -- format line
- ;
- N NPFSSN,NPFNM,NPFSEX,NPFDOB,NPFIEN
- ;
- S NPFSSN=$P(DATA,U,1)
- S NPFNM=$P(DATA,U,2)
- S NPFSEX=$P(DATA,U,3)
- I NPFSEX="" S NPFSEX="-"
- S NPFDOB=$P(DATA,U,4)
- S NPFIEN=$P(DATA,U,5)
- ;
- N C1,C2,C3,C4,C5
- ;
- ;NPF values
- S C1=$$LJ^XLFSTR(NPFSSN,9," ")
- S C2=$$LJ^XLFSTR(NPFNM,30," ")
- S C3=$$CJ^XLFSTR(NPFSEX,3," ")
- I NPFDOB="" S C4="---------- "
- I NPFDOB'="" S C4=$$LJ^XLFSTR($$DOB(NPFDOB),11," ")
- S C5=$$RJ^XLFSTR(NPFIEN,14," ")
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
- ;
- S CNT=$G(CNT)+1
- S ^TMP(NODE,$J,CNT)=""
- ;
- Q
- ;
- UPDSEX ;Update SEX if NPF SEX is null
- I $E(XUPSACT,1)'="U" Q
- ;
- N DIE,DA,DR
- S DIE=200,DA=IEN200
- I NPFSEX="" D
- . S DR="4///^S X=PAIDSEX"
- . D ^DIE
- Q
- ;
- UPDDOB ;Update DOB if NPF DOB is null
- I $E(XUPSACT,1)'="U" Q
- ;
- N DIE,DA,DR
- S DIE=200,DA=IEN200
- I NPFDOB="" D
- . S DR="5///^S X=PAIDDOB"
- . D ^DIE
- Q
- ;
- NAME(NAME) ; Return "LastName,FirstName".
- ;
- N RESULT,STDNM
- ;
- S RESULT=""
- ;
- ; CALL FORMAT^XLFNAME7
- S STDNM=$$FORMAT^XLFNAME7(.NAME,3,35)
- ;
- ; Return LastName,FirstName
- S RESULT=$P($G(STDNM)," ",1)
- ;
- Q RESULT
- ;
- DOB(DOB) ; format DOB
- ;
- Q:DOB="" ""
- ;
- Q $E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_(1700+$E(DOB,1,3))
- ;
- PSDT() ; format date
- ;
- N %
- ;
- D NOW^%DTC S Y=% D DD^%DT
- ;
- Q Y
- ;
- XM(XMSUB,X) ;Email the report
- ;If called within a task, protect variables
- I $D(ZTQUEUED) N %,DIFROM
- ;
- N XMY,XMTEXT,XMDUZ
- S XMY(DUZ)="",XMDUZ=.5
- S XMTEXT="^TMP("""_X_""",$J,"
- D ^XMD
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPSPAID 9782 printed Feb 18, 2025@23:38:09 Page 2
- XUPSPAID ;CS/GRR/RAM/DW - New Person file Update & Report ; 1 Jan 2004
- +1 ;;8.0;KERNEL;**309,343**; Jul 10, 1995;
- +2 ;
- +3 QUIT
- +4 ;
- EN ; - entry point
- +1 ;
- +2 NEW DIRUT,X,Y
- +3 ;
- +4 IF $EXTRACT(XUPSACT,1)="U"
- Begin DoDot:1
- +5 WRITE !!," *********************************************"
- +6 WRITE !," *This option will UPDATE eligible New Person*"
- +7 WRITE !," *file (#200) entries with missing DOB or SEX*"
- +8 WRITE !," *********************************************"
- End DoDot:1
- +9 ;
- +10 WRITE !!,"The reports will be sent to you via MailMan",!
- +11 ;
- +12 SET DIR(0)="YA"
- SET DIR("B")="Yes"
- SET DIR("A")="Do you wish to continue? "
- +13 SET DIR("?")="Enter 'Yes' to continue or 'No' to quit"
- +14 ;ask user if they want to continue with option
- DO ^DIR
- KILL DIR
- +15 ;user responded No or with '^' to exit
- if 'Y!($DATA(DIRUT))
- QUIT
- +16 ;
- +17 DO QUE
- +18 ;
- +19 KILL XUPSACT
- +20 QUIT
- +21 ;
- QUE ;Que the task
- +1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
- +2 WRITE !
- +3 SET ZTIO=""
- +4 SET ZTRTN="EN1^XUPSPAID"
- +5 SET ZTSAVE("XUPSACT")=""
- +6 IF $EXTRACT(XUPSACT,1)="U"
- SET ZTDESC="XUPS NPF UPDATE"
- +7 IF $EXTRACT(XUPSACT,1)="P"
- SET ZTDESC="XUPS NPF PREUPDATE REPORT"
- +8 DO ^%ZTLOAD
- +9 DO ^%ZISC
- DO HOME^%ZIS
- +10 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
- +11 ;
- +12 QUIT
- +13 ;
- EN1 ;
- +1 NEW IEN,XUPSDIFF,XUPSUPD,XUT,XUNPFT,XUUPDT
- +2 SET (XUNPFT,XUUPDT)=0
- +3 ;
- +4 KILL ^TMP("XUPS PAID",$JOB)
- +5 KILL ^TMP("XUPS DIFF",$JOB)
- +6 KILL ^TMP("XUPS UPD",$JOB)
- +7 ;
- +8 SET XUPSDIFF("SSN")=0
- +9 SET XUPSDIFF("NAME")=0
- +10 SET XUPSDIFF("SEX")=0
- +11 SET XUPSDIFF("DOB")=0
- +12 ;
- +13 SET XUPSUPD("SEX")=0
- +14 SET XUPSUPD("DOB")=0
- +15 ;
- +16 SET IEN=0
- +17 FOR
- SET IEN=$ORDER(^PRSPC(IEN))
- if 'IEN
- QUIT
- DO RECORD
- +18 ;
- +19 SET XUT(1)=$GET(XUNPFT)
- +20 SET XUT(2)=$GET(XUUPDT)
- +21 IF $EXTRACT(XUPSACT,1)="U"
- DO NOTICE^XUPSPD1(.XUT)
- +22 ;
- +23 DO REPORT
- +24 ;
- +25 QUIT
- +26 ;
- REPORT ;Pre-update reports
- +1 ;
- +2 NEW CNTG,DATA,DATA1,IEN,CNT,CNTU,CNTD
- +3 SET (CNTG,CNT,CNTU,CNTD)=0
- +4 ;
- +5 ;The difference report
- +6 DO HD("XUPS DIFF")
- +7 SET IEN=0
- +8 FOR
- SET IEN=$ORDER(^TMP("XUPS PAID",$JOB,"DIFF",IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +9 SET DATA=^TMP("XUPS PAID",$JOB,"DIFF",IEN)
- +10 DO FL("XUPS DIFF",DATA)
- +11 SET CNTD=$GET(CNTD)+1
- End DoDot:1
- +12 SET CNT=$GET(CNT)+1
- +13 SET ^TMP("XUPS DIFF",$JOB,CNT)=""
- +14 SET CNT=$GET(CNT)+1
- +15 SET ^TMP("XUPS DIFF",$JOB,CNT)=" Totals"
- +16 SET CNT=$GET(CNT)+1
- +17 SET ^TMP("XUPS DIFF",$JOB,CNT)=" Different LastName,FirstName: "_$GET(XUPSDIFF("NAME"))
- +18 SET CNT=$GET(CNT)+1
- +19 SET ^TMP("XUPS DIFF",$JOB,CNT)=" Same LastName,FirstName, different Sex: "_$GET(XUPSDIFF("SEX"))
- +20 SET CNT=$GET(CNT)+1
- +21 SET ^TMP("XUPS DIFF",$JOB,CNT)=" Same LastName,FirstName, different DOB: "_$GET(XUPSDIFF("DOB"))
- +22 SET CNT=$GET(CNT)+1
- +23 SET ^TMP("XUPS DIFF",$JOB,CNT)=" New Person file entries: "_$GET(CNTD)
- +24 ;
- +25 ;The update report
- +26 SET CNT=0
- +27 DO HD1("XUPS UPD")
- +28 SET IEN=0
- +29 FOR
- SET IEN=$ORDER(^TMP("XUPS PAID",$JOB,"UPD",IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +30 SET DATA=^TMP("XUPS PAID",$JOB,"UPD",IEN)
- +31 DO FL1("XUPS UPD",DATA)
- +32 SET CNTU=$GET(CNTU)+1
- End DoDot:1
- +33 SET CNT=$GET(CNT)+1
- +34 SET ^TMP("XUPS UPD",$JOB,CNT)=""
- +35 SET CNT=$GET(CNT)+1
- +36 SET ^TMP("XUPS UPD",$JOB,CNT)=" Totals"
- +37 SET CNT=$GET(CNT)+1
- +38 SET ^TMP("XUPS UPD",$JOB,CNT)=" Sex fields: "_XUPSUPD("SEX")
- +39 SET CNT=$GET(CNT)+1
- +40 SET ^TMP("XUPS UPD",$JOB,CNT)=" DOB fields: "_XUPSUPD("DOB")
- +41 SET CNT=$GET(CNT)+1
- +42 SET ^TMP("XUPS UPD",$JOB,CNT)=" New Person entries: "_$GET(CNTU)
- +43 ;
- +44 DO XM("Update NPF with PAID data - Sex and DOB","XUPS UPD")
- +45 DO XM("Differences between NPF and PAID files","XUPS DIFF")
- +46 ;
- +47 KILL ^TMP("XUPS PAID",$JOB)
- +48 KILL ^TMP("XUPS DIFF",$JOB)
- +49 KILL ^TMP("XUPS UPD",$JOB)
- +50 ;
- +51 QUIT
- +52 ;
- RECORD ;Process the record
- +1 ;
- +2 NEW IEN200,DATA,DATA1
- +3 NEW PAIDNM,PAIDOB,PAIDSSN,PAIDSEX
- +4 NEW NPFNM,NPFSEX,NPFDOB,NPFSSN
- +5 ;
- +6 ; NPF IEN
- +7 SET IEN200=$PIECE($GET(^PRSPC(IEN,200)),"^",1)
- +8 ;
- +9 if 'IEN200
- QUIT
- +10 SET XUNPFT=$GET(XUNPFT)+1
- +11 ;
- +12 ; PAID file
- +13 SET DATA=$GET(^PRSPC(IEN,0))
- +14 SET PAIDNM=$PIECE(DATA,"^",1)
- +15 SET PAIDDOB=$PIECE(DATA,"^",33)
- +16 SET PAIDSSN=$PIECE(DATA,"^",9)
- +17 SET PAIDSEX=$PIECE(DATA,"^",32)
- +18 ; transform SEX code PAID to NPF
- +19 SET PAIDSEX=$SELECT(PAIDSEX="":"",PAIDSEX=1:"M",PAIDSEX=2:"F",1:"")
- +20 ;
- +21 ; New Person File
- +22 SET DATA=$GET(^VA(200,IEN200,1))
- +23 SET NPFNM=$PIECE($GET(^VA(200,IEN200,0)),U)
- +24 SET NPFSEX=$PIECE(DATA,"^",2)
- +25 SET NPFDOB=$PIECE(DATA,"^",3)
- +26 SET NPFSSN=$PIECE(DATA,"^",9)
- +27 ;
- +28 if NPFSSN'=PAIDSSN
- QUIT
- +29 ;
- +30 SET DATA=NPFNM_U_NPFSEX_U_NPFDOB_U_NPFSSN
- +31 SET DATA=DATA_U_PAIDNM_U_PAIDSEX_U_PAIDDOB_U_PAIDSSN_U_IEN200
- +32 ;
- +33 SET DATA1=NPFSSN_U_NPFNM_U_U_U_IEN200
- +34 ;
- +35 IF $$NAME(NPFNM)'=$$NAME(PAIDNM)
- Begin DoDot:1
- +36 SET XUPSDIFF("NAME")=XUPSDIFF("NAME")+1
- +37 SET ^TMP("XUPS PAID",$JOB,"DIFF",IEN200)=DATA
- End DoDot:1
- QUIT
- +38 ;
- +39 IF PAIDSEX'=""
- Begin DoDot:1
- +40 IF NPFSEX=""
- Begin DoDot:2
- +41 SET $PIECE(DATA1,U,3)=PAIDSEX
- +42 SET XUPSUPD("SEX")=XUPSUPD("SEX")+1
- +43 SET ^TMP("XUPS PAID",$JOB,"UPD",IEN200)=DATA1
- +44 IF $EXTRACT(XUPSACT,1)="U"
- Begin DoDot:3
- +45 DO UPDSEX
- +46 SET XUUPDT=$GET(XUUPDT)+1
- End DoDot:3
- End DoDot:2
- QUIT
- +47 IF NPFSEX'=PAIDSEX
- Begin DoDot:2
- +48 SET XUPSDIFF("SEX")=XUPSDIFF("SEX")+1
- +49 SET ^TMP("XUPS PAID",$JOB,"DIFF",IEN200)=DATA
- End DoDot:2
- QUIT
- End DoDot:1
- +50 ;
- +51 IF PAIDDOB'=""
- Begin DoDot:1
- +52 IF NPFDOB=""
- Begin DoDot:2
- +53 SET $PIECE(DATA1,U,4)=PAIDDOB
- +54 SET XUPSUPD("DOB")=XUPSUPD("DOB")+1
- +55 SET ^TMP("XUPS PAID",$JOB,"UPD",IEN200)=DATA1
- +56 IF $EXTRACT(XUPSACT,1)="U"
- Begin DoDot:3
- +57 DO UPDDOB
- +58 SET XUUPDT=$GET(XUUPDT)+1
- End DoDot:3
- End DoDot:2
- QUIT
- +59 IF NPFDOB'=PAIDDOB
- Begin DoDot:2
- +60 SET XUPSDIFF("DOB")=XUPSDIFF("DOB")+1
- +61 SET ^TMP("XUPS PAID",$JOB,"DIFF",IEN200)=DATA
- End DoDot:2
- QUIT
- End DoDot:1
- +62 ;
- +63 QUIT
- +64 ;
- HD(NODE) ; -- Report header
- +1 NEW C1,C2,C3,C4,C5
- +2 ;
- +3 SET CNT=$GET(CNT)+1
- +4 SET ^TMP(NODE,$JOB,CNT)=""
- +5 ;
- +6 IF NODE="XUPS DIFF"
- Begin DoDot:1
- +7 SET CNT=$GET(CNT)+1
- +8 SET ^TMP(NODE,$JOB,CNT)="The following New Person File entries have different LastName,FirstName,"
- +9 SET CNT=$GET(CNT)+1
- +10 SET ^TMP(NODE,$JOB,CNT)="or same LastName,FirstName but different Sex or DOB with their linked PAID"
- +11 SET CNT=$GET(CNT)+1
- +12 SET ^TMP(NODE,$JOB,CNT)="Employee entries."
- End DoDot:1
- +13 ;
- +14 SET CNT=$GET(CNT)+1
- +15 SET ^TMP(NODE,$JOB,CNT)=""
- +16 ;
- +17 SET C1=$$LJ^XLFSTR("NPF - Name",30," ")
- +18 SET C2=$$CJ^XLFSTR("SEX",3," ")
- +19 SET C3=$$LJ^XLFSTR("DOB",11," ")
- +20 SET C4=$$LJ^XLFSTR("SSN",9," ")
- +21 SET C5=$$RJ^XLFSTR("IEN",14," ")
- +22 ;
- +23 SET CNT=$GET(CNT)+1
- +24 SET ^TMP(NODE,$JOB,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- +25 ;
- +26 SET C1=$$LJ^XLFSTR("PAID -",30," ")
- +27 SET C2=$$CJ^XLFSTR("",3," ")
- +28 SET C3=$$LJ^XLFSTR("",11," ")
- +29 SET C4=$$LJ^XLFSTR("",9," ")
- +30 SET C5=$$RJ^XLFSTR("",14," ")
- +31 ;
- +32 SET CNT=$GET(CNT)+1
- +33 SET ^TMP(NODE,$JOB,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- +34 ;
- +35 SET C1=$$LJ^XLFSTR("=================",30," ")
- +36 SET C2=$$CJ^XLFSTR("===",3," ")
- +37 SET C3=$$LJ^XLFSTR("==========",11," ")
- +38 SET C4=$$LJ^XLFSTR("=========",9," ")
- +39 SET C5=$$RJ^XLFSTR("===",14," ")
- +40 ;
- +41 SET CNT=$GET(CNT)+1
- +42 SET ^TMP(NODE,$JOB,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- +43 ;
- +44 SET CNT=$GET(CNT)+1
- +45 SET ^TMP(NODE,$JOB,CNT)=""
- +46 ;
- +47 QUIT
- +48 ;
- FL(NODE,DATA) ; -- format line
- +1 ;
- +2 NEW NPFNM,NPFSEX,NPFDOB,NPFSSN,NPFIEN
- +3 NEW PAIDNM,PAIDSEX,PAIDDOB,PAIDSSN
- +4 ;
- +5 SET NPFNM=$PIECE(DATA,U,1)
- +6 SET NPFSEX=$PIECE(DATA,U,2)
- +7 SET NPFDOB=$PIECE(DATA,U,3)
- +8 SET NPFSSN=$PIECE(DATA,U,4)
- +9 SET NPFIEN=$PIECE(DATA,U,9)
- +10 SET PAIDNM=$PIECE(DATA,U,5)
- +11 SET PAIDSEX=$PIECE(DATA,U,6)
- +12 SET PAIDDOB=$PIECE(DATA,U,7)
- +13 SET PAIDSSN=$PIECE(DATA,U,8)
- +14 ;
- +15 NEW C1,C2,C3,C4,C5
- +16 ;
- +17 ;NPF values
- +18 SET C1=$$LJ^XLFSTR(NPFNM,30," ")
- +19 SET C2=$$CJ^XLFSTR(NPFSEX,3," ")
- +20 SET C3=$$LJ^XLFSTR($$DOB(NPFDOB),11," ")
- +21 SET C4=$$LJ^XLFSTR(NPFSSN,9," ")
- +22 SET C5=$$RJ^XLFSTR(NPFIEN,14," ")
- +23 ;
- +24 SET CNT=$GET(CNT)+1
- +25 SET ^TMP(NODE,$JOB,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- +26 ;
- +27 ;PAID values
- +28 SET C1=$$LJ^XLFSTR(PAIDNM,30," ")
- +29 SET C2=$$CJ^XLFSTR(PAIDSEX,3," ")
- +30 SET C3=$$LJ^XLFSTR($$DOB(PAIDDOB),11," ")
- +31 SET C4=$$LJ^XLFSTR(PAIDSSN,9," ")
- +32 SET C5=$$RJ^XLFSTR(" ",14," ")
- +33 ;
- +34 SET CNT=$GET(CNT)+1
- +35 SET ^TMP(NODE,$JOB,CNT)=C1_C2_" "_C3_" "_C4_" "_C5
- +36 ;
- +37 SET CNT=$GET(CNT)+1
- +38 SET ^TMP(NODE,$JOB,CNT)=""
- +39 ;
- +40 QUIT
- +41 ;
- HD1(NODE) ; -- Report header
- +1 ;
- +2 NEW C1,C2,C3,C4,C5
- +3 ;
- +4 SET CNT=$GET(CNT)+1
- +5 SET ^TMP(NODE,$JOB,CNT)=""
- +6 ;
- +7 IF NODE="XUPS UPD"
- Begin DoDot:1
- +8 SET CNT=$GET(CNT)+1
- +9 SET ^TMP(NODE,$JOB,CNT)="The following New Person File entries will be updated."
- +10 SET CNT=$GET(CNT)+1
- +11 SET ^TMP(NODE,$JOB,CNT)="The DOB or Sex fields to be updated are shown with the PAID values;"
- +12 SET CNT=$GET(CNT)+1
- +13 SET ^TMP(NODE,$JOB,CNT)="The DOB or Sex fields not to be updated are shown with ""-""."
- End DoDot:1
- +14 ;
- +15 SET CNT=$GET(CNT)+1
- +16 SET ^TMP(NODE,$JOB,CNT)=""
- +17 ;
- +18 SET C1=$$LJ^XLFSTR("SSN",9," ")
- +19 SET C2=$$LJ^XLFSTR("NPF Name",30," ")
- +20 SET C3=$$LJ^XLFSTR("SEX",3," ")
- +21 SET C4=$$LJ^XLFSTR("DOB",11," ")
- +22 SET C5=$$RJ^XLFSTR("IEN",14," ")
- +23 ;
- +24 SET CNT=$GET(CNT)+1
- +25 SET ^TMP(NODE,$JOB,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
- +26 ;
- +27 SET C1=$$LJ^XLFSTR("=========",9," ")
- +28 SET C2=$$LJ^XLFSTR("=================",30," ")
- +29 SET C3=$$CJ^XLFSTR("===",3," ")
- +30 SET C4=$$LJ^XLFSTR("==========",11," ")
- +31 SET C5=$$RJ^XLFSTR("===",14," ")
- +32 ;
- +33 SET CNT=$GET(CNT)+1
- +34 SET ^TMP(NODE,$JOB,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
- +35 ;
- +36 SET CNT=$GET(CNT)+1
- +37 SET ^TMP(NODE,$JOB,CNT)=""
- +38 ;
- +39 QUIT
- +40 ;
- FL1(NODE,DATA) ; -- format line
- +1 ;
- +2 NEW NPFSSN,NPFNM,NPFSEX,NPFDOB,NPFIEN
- +3 ;
- +4 SET NPFSSN=$PIECE(DATA,U,1)
- +5 SET NPFNM=$PIECE(DATA,U,2)
- +6 SET NPFSEX=$PIECE(DATA,U,3)
- +7 IF NPFSEX=""
- SET NPFSEX="-"
- +8 SET NPFDOB=$PIECE(DATA,U,4)
- +9 SET NPFIEN=$PIECE(DATA,U,5)
- +10 ;
- +11 NEW C1,C2,C3,C4,C5
- +12 ;
- +13 ;NPF values
- +14 SET C1=$$LJ^XLFSTR(NPFSSN,9," ")
- +15 SET C2=$$LJ^XLFSTR(NPFNM,30," ")
- +16 SET C3=$$CJ^XLFSTR(NPFSEX,3," ")
- +17 IF NPFDOB=""
- SET C4="---------- "
- +18 IF NPFDOB'=""
- SET C4=$$LJ^XLFSTR($$DOB(NPFDOB),11," ")
- +19 SET C5=$$RJ^XLFSTR(NPFIEN,14," ")
- +20 ;
- +21 SET CNT=$GET(CNT)+1
- +22 SET ^TMP(NODE,$JOB,CNT)=C1_" "_C2_" "_C3_" "_C4_" "_C5
- +23 ;
- +24 SET CNT=$GET(CNT)+1
- +25 SET ^TMP(NODE,$JOB,CNT)=""
- +26 ;
- +27 QUIT
- +28 ;
- UPDSEX ;Update SEX if NPF SEX is null
- +1 IF $EXTRACT(XUPSACT,1)'="U"
- QUIT
- +2 ;
- +3 NEW DIE,DA,DR
- +4 SET DIE=200
- SET DA=IEN200
- +5 IF NPFSEX=""
- Begin DoDot:1
- +6 SET DR="4///^S X=PAIDSEX"
- +7 DO ^DIE
- End DoDot:1
- +8 QUIT
- +9 ;
- UPDDOB ;Update DOB if NPF DOB is null
- +1 IF $EXTRACT(XUPSACT,1)'="U"
- QUIT
- +2 ;
- +3 NEW DIE,DA,DR
- +4 SET DIE=200
- SET DA=IEN200
- +5 IF NPFDOB=""
- Begin DoDot:1
- +6 SET DR="5///^S X=PAIDDOB"
- +7 DO ^DIE
- End DoDot:1
- +8 QUIT
- +9 ;
- NAME(NAME) ; Return "LastName,FirstName".
- +1 ;
- +2 NEW RESULT,STDNM
- +3 ;
- +4 SET RESULT=""
- +5 ;
- +6 ; CALL FORMAT^XLFNAME7
- +7 SET STDNM=$$FORMAT^XLFNAME7(.NAME,3,35)
- +8 ;
- +9 ; Return LastName,FirstName
- +10 SET RESULT=$PIECE($GET(STDNM)," ",1)
- +11 ;
- +12 QUIT RESULT
- +13 ;
- DOB(DOB) ; format DOB
- +1 ;
- +2 if DOB=""
- QUIT ""
- +3 ;
- +4 QUIT $EXTRACT(DOB,4,5)_"/"_$EXTRACT(DOB,6,7)_"/"_(1700+$EXTRACT(DOB,1,3))
- +5 ;
- PSDT() ; format date
- +1 ;
- +2 NEW %
- +3 ;
- +4 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +5 ;
- +6 QUIT Y
- +7 ;
- XM(XMSUB,X) ;Email the report
- +1 ;If called within a task, protect variables
- +2 IF $DATA(ZTQUEUED)
- NEW %,DIFROM
- +3 ;
- +4 NEW XMY,XMTEXT,XMDUZ
- +5 SET XMY(DUZ)=""
- SET XMDUZ=.5
- +6 SET XMTEXT="^TMP("""_X_""",$J,"
- +7 DO ^XMD
- +8 ;
- +9 QUIT
- +10 ;