- DG53358M ;ALB/AEG - DG*5.3*358 POST INSTALL (CONT) ;3-5-2001
- ;;5.3;Registration;**358,1015**;3-5-2001;Build 21
- ;
- MBDST ; Called after Phase II processing completes to send user a message
- ; as to the details of mt status inconsistencies.
- I '$D(^TMP($J,"PAT")) D
- .S ^UTILITY($J,1)="No inconsistencies were noted between the CURRENT MEANS TEST"
- .S ^UTILITY($J,2)="STATUS field (#.14) of the PATIENT file (#2) and the STATUS"
- .S ^UTILITY($J,3)="field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
- I $D(^TMP($J,"PAT")) D
- .S ^UTILITY($J,1)="The following inconsistencies were found between the CURRENT MEANS"
- .S ^UTILITY($J,2)="TEST STATUS field (#.14) of the PATIENT file (#2) and the"
- .S ^UTILITY($J,3)="STATUS field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
- .S ^UTILITY($J,4)="The inconsistencies have been corrected."
- .S ^UTILITY($J,5)=" "
- .S ^UTILITY($J,6)=$$BLDSTR("PATIENT NAME","SSN","CATEGORY (PAT)","CATEGORY (MEANS)")
- .S ^UTILITY($J,7)=$$BLDSTR("------------","---","--------------","----------------")
- .N NM,IEN,I,DFN,DPTS,LST4,P1,P2,P3,P4,NM1
- .S (NM,IEN)=""
- .F I=8:1 S NM=$O(^TMP($J,"PAT",NM)) Q:NM="" S IEN="" F S IEN=$O(^TMP($J,"PAT",NM,IEN)) Q:IEN="" D
- ..S DFN=$P($G(^TMP($J,"PAT",NM,IEN)),U,1),DPTS=$P($G(^TMP($J,"PAT",NM,IEN)),U,2)
- ..S DPTS=$S(DPTS'="":$P($G(^DG(408.32,DPTS,0)),U,1),DPTS="":" ",1:" ")
- ..S DGMTS=$P($G(^TMP($J,"PAT",NM,IEN)),U,4),DGMTS=$S(DGMTS'="":$P($G(^DG(408.32,DGMTS,0)),U,1),DGMTS="":" ",1:" ")
- ..S NM1=$E($G(NM),1,15) I NM1["^" S NM1=$P($G(NM1),U,1)
- ..S LST4=$E($P($G(^DPT(DFN,0)),U,9),6,9)
- ..S P1=NM1,P2=LST4,P3=DPTS,P4=DGMTS
- ..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
- ..Q
- .Q
- N DIFROM,%
- N XMDUZ,XMSUB,XMTEXT,XMY,Y
- S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- S XMTEXT="^UTILITY($J,"
- D NOW^%DTC S Y=% D DD^%DT
- S XMSUB="DG*5.3*358 POST INSTALL - Phase II report "_Y
- D ^XMD
- D BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- K ^UTILITY($J),^TMP($J,"PAT")
- Q
- BADEN ; Process Phase III portion of cleanup report
- K ^UTILITY($J)
- I '$D(^TMP($J,"BADEN")) D
- .S ^UTILITY($J,1)="No means test records found where the CURRENT MEANS TEST STATUS field (#.14)"
- .S ^UTILITY($J,2)="of the PATIENT file (#2) was populated without a corresponding"
- .S ^UTILITY($J,3)="Means Test on file."
- I $D(^TMP($J,"BADEN")) D
- .S ^UTILITY($J,1)="The following patients had the CURRENT MEANS TEST STATUS field (#.14)"
- .S ^UTILITY($J,2)="of the PATIENT file (#2) populated; however, there was no"
- .S ^UTILITY($J,3)="corresponding Means Test on File. The PATIENT file has been"
- .S ^UTILITY($J,4)="updated."
- .S ^UTILITY($J,5)=" "
- .S ^UTILITY($J,6)=$$BLDSTR("PATIENT NAME","SSN","CURRENT MT STATUS","")
- .S ^UTILITY($J,7)=$$BLDSTR("------------","---","-----------------","")
- .N DGDFN,DPTSTAT,NM,NM1,LST4,DPTS,P1,P2,P3,P4
- .S (DGDFN,DPTSTAT)=""
- .F I=8:1 S DGDFN=$O(^TMP($J,"BADEN",DGDFN)) Q:'+DGDFN S DPTSTAT="" F S DPTSTAT=$O(^TMP($J,"BADEN",DGDFN,DPTSTAT)) Q:DPTSTAT="" D
- ..S NM=$P($G(^DPT(DGDFN,0)),U),NM1=$E($G(NM),1,15)
- ..S LST4=$E($P($G(^DPT(DGDFN,0)),U,9),6,9)
- ..S DPTS=$P($G(^DG(408.32,DPTSTAT,0)),U,1),DPTS=$E($G(DPTS),1,15)
- ..S P1=NM1,P2=LST4,P3=DPTS,P4=""
- ..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
- ..Q
- .Q
- N DIFROM,%,Y
- N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- D NOW^%DTC S Y=% D DD^%DT
- S XMSUB="DG*5.3*358 POST INSTALL - Phase III report "_Y
- S XMTEXT="^UTILITY($J,"
- D ^XMD
- D BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- K ^TMP($J,"BADEN"),^UTILITY($J)
- Q
- DOAN ; Phase IV Process Reporting
- ;
- ; This reporting mechanism is broken down into 2 distinct parts.
- ;
- ; 1. An email will be generated on those patients that were in a NLR
- ; status and the date of the test was > than the date of death. The
- ; tests meeting those criteria were treated as invalid and purged.
- ;
- ; 2. An email will be generated for those test in an NLR status on
- ; expired patients where the date of the test was on or before the
- ; date of death. These test statii were recalculated to what they
- ; were prior to date of death.
- ;
- ; PART I
- I '$D(^TMP($J,"NLR-DEL")) D
- .S ^UTILITY($J,1)="No means test records were found in a status of 'NO LONGER REQUIRED'"
- .S ^UTILITY($J,2)="where the date of the test is greater than the date of death."
- I $D(^TMP($J,"NLR-DEL")) D
- .S ^UTILITY($J,1)="The following means tests were found in a status of 'NO LONGER REQUIRED'"
- .S ^UTILITY($J,2)="and the test date was entered after the date of death. These tests"
- .S ^UTILITY($J,3)="are considered to be invalid and have been purged."
- .S ^UTILITY($J,4)=" "
- .S ^UTILITY($J,5)=$$BLDSTR("PATIENT NAME","SSN","DATE OF DEATH","DATE OF TEST")
- .S ^UTILITY($J,6)=$$BLDSTR("------------","---","-------------","------------")
- .N DGDFN,DGMTI,DGDOD,DGMTS,DOD,DOT,DOT1,DGDFN1
- .S (DGDFN,DGMTI,DGDFN1)=""
- .F I=8:1 S DGDFN1=$O(^TMP($J,"NLR-DEL",DGDFN1)) Q:'+DGDFN1 D
- ..S DGDFN=$P($G(DGDFN1),"~~",1),DGMTI=$P($G(DGDFN1),"~~",2)
- ..S NM=$P($G(^DPT(DGDFN,0)),U,1),NM1=$E($G(NM),1,15)
- ..S LST4=$E($P($G(^DPT(DGDFN,0)),U,9),6,9)
- ..S DOT=$P($G(^TMP($J,"NLR-DEL",DGDFN1)),U,1)
- ..S Y=DOT X ^DD("DD") S DOT1=Y
- ..S DOD=$P($G(^DPT(DGDFN,.35)),U),Y=$P($G(DOD),".",1)
- ..X ^DD("DD") S DGDOD=Y
- ..S P1=NM1,P2=LST4,P3=DGDOD,P4=DOT1
- ..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
- ..Q
- .Q
- N DIFROM,%,Y
- N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- S XMTEXT="^UTILITY($J,"
- N %,Y
- D NOW^%DTC S Y=% D DD^%DT
- S XMSUB="DG*5.3*358 POST INSTALL - PHASE IV (PART 1) "_Y
- D ^XMD
- D MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- K ^UTILITY($J),^TMP($J,"NLR-DEL")
- ;
- P2 ; PART 2
- I '$D(^TMP($J,"RECALC")) D
- .S ^UTILITY($J,1)="No means test records found where the status is 'NO LONGER REQUIRED'"
- .S ^UTILITY($J,2)="and the test date is on or before the date of death."
- I $D(^TMP($J,"RECALC")) D
- .N OLDSTAT,NEWSTAT,DGDFN,NEWCAT,OLDCAT,PID,TDATE,TDATE1,DGDFN1
- .S (OLDSTAT,NEWSTAT,DGDFN,DGDFN1)=""
- .S ^UTILITY($J,1)="The following patients have expired and had a means test"
- .S ^UTILITY($J,2)="on file in a status of 'NO LONGER REQUIRED'. The test"
- .S ^UTILITY($J,3)="dates are on or prior to the date of death; therefore, the status"
- .S ^UTILITY($J,4)="has been recalculated to reflect the status at the time of"
- .S ^UTILITY($J,5)="death."
- .S ^UTILITY($J,6)=" "
- .S ^UTILITY($J,7)=$$BLDSTR("PATIENT SSN","TEST DATE","OLD STATUS","NEW STATUS")
- .S ^UTILITY($J,8)=$$BLDSTR("----------","---------","----------","----------")
- .F I=9:1 S DGDFN1=$O(^TMP($J,"RECALC",DGDFN1)) Q:'+DGDFN1 D
- ..S DGDFN=$P($G(DGDFN1),"~~",1),TDATE=$P($G(DGDFN1),"~~",2)
- ..S PID=$E($P($G(^DPT(DGDFN,0)),U,9),1,3)_"-"_$E($P($G(^DPT(DGDFN,0)),U,9),4,5)_"-"_$E($P($G(^DPT(DGDFN,0)),U,9),6,9)
- ..S Y=TDATE X ^DD("DD") S TDATE1=Y
- ..S OLDCAT=$P($G(^TMP($J,"RECALC",DGDFN1)),U,1)
- ..S NEWCAT=$P($G(^TMP($J,"RECALC",DGDFN1)),U,2)
- ..S P1=PID,P2=TDATE1,P3=OLDCAT,P4=NEWCAT
- ..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
- ..Q
- .Q
- N DIFROM,%,Y
- N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- S XMTEXT="^UTILITY($J,"
- D NOW^%DTC S Y=% D DD^%DT
- S XMSUB="DG*5.3*358 POST INSTALL - Phase IV (Part II) "_Y
- D ^XMD
- D MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- K ^UTILITY($J),^TMP($J,"RECALC")
- Q
- BLDSTR(P1,P2,P3,P4) ; Build a string from input
- N S1,S2,S3,S4
- S S1=$E(P1,1,15) I $L(S1)'>14 D
- .S S1=S1_$J("",(15-$L(S1)))
- S S2=P2
- S S3=$E(P3,1,15) I $L(S3)'>14 D
- .S S3=S3_$J("",(15-$L(S3)))
- S S4=$E(P4,1,15) I $L(S4)'>14 D
- .S S4=S4_$J("",(15-$L(S4)))
- Q S1_$J("",5)_S2_$J("",5)_S3_$J("",5)_S4
- DG53358M ;ALB/AEG - DG*5.3*358 POST INSTALL (CONT) ;3-5-2001
- +1 ;;5.3;Registration;**358,1015**;3-5-2001;Build 21
- +2 ;
- MBDST ; Called after Phase II processing completes to send user a message
- +1 ; as to the details of mt status inconsistencies.
- +2 IF '$DATA(^TMP($JOB,"PAT"))
- Begin DoDot:1
- +3 SET ^UTILITY($JOB,1)="No inconsistencies were noted between the CURRENT MEANS TEST"
- +4 SET ^UTILITY($JOB,2)="STATUS field (#.14) of the PATIENT file (#2) and the STATUS"
- +5 SET ^UTILITY($JOB,3)="field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
- End DoDot:1
- +6 IF $DATA(^TMP($JOB,"PAT"))
- Begin DoDot:1
- +7 SET ^UTILITY($JOB,1)="The following inconsistencies were found between the CURRENT MEANS"
- +8 SET ^UTILITY($JOB,2)="TEST STATUS field (#.14) of the PATIENT file (#2) and the"
- +9 SET ^UTILITY($JOB,3)="STATUS field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
- +10 SET ^UTILITY($JOB,4)="The inconsistencies have been corrected."
- +11 SET ^UTILITY($JOB,5)=" "
- +12 SET ^UTILITY($JOB,6)=$$BLDSTR("PATIENT NAME","SSN","CATEGORY (PAT)","CATEGORY (MEANS)")
- +13 SET ^UTILITY($JOB,7)=$$BLDSTR("------------","---","--------------","----------------")
- +14 NEW NM,IEN,I,DFN,DPTS,LST4,P1,P2,P3,P4,NM1
- +15 SET (NM,IEN)=""
- +16 FOR I=8:1
- SET NM=$ORDER(^TMP($JOB,"PAT",NM))
- IF NM=""
- QUIT
- SET IEN=""
- FOR
- SET IEN=$ORDER(^TMP($JOB,"PAT",NM,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +17 SET DFN=$PIECE($GET(^TMP($JOB,"PAT",NM,IEN)),U,1)
- SET DPTS=$PIECE($GET(^TMP($JOB,"PAT",NM,IEN)),U,2)
- +18 SET DPTS=$SELECT(DPTS'="":$PIECE($GET(^DG(408.32,DPTS,0)),U,1),DPTS="":" ",1:" ")
- +19 SET DGMTS=$PIECE($GET(^TMP($JOB,"PAT",NM,IEN)),U,4)
- SET DGMTS=$SELECT(DGMTS'="":$PIECE($GET(^DG(408.32,DGMTS,0)),U,1),DGMTS="":" ",1:" ")
- +20 SET NM1=$EXTRACT($GET(NM),1,15)
- IF NM1["^"
- SET NM1=$PIECE($GET(NM1),U,1)
- +21 SET LST4=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
- +22 SET P1=NM1
- SET P2=LST4
- SET P3=DPTS
- SET P4=DGMTS
- +23 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
- +24 QUIT
- End DoDot:2
- +25 QUIT
- End DoDot:1
- +26 NEW DIFROM,%
- +27 NEW XMDUZ,XMSUB,XMTEXT,XMY,Y
- +28 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +29 SET XMTEXT="^UTILITY($J,"
- +30 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +31 SET XMSUB="DG*5.3*358 POST INSTALL - Phase II report "_Y
- +32 DO ^XMD
- +33 DO BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- +34 KILL ^UTILITY($JOB),^TMP($JOB,"PAT")
- +35 QUIT
- BADEN ; Process Phase III portion of cleanup report
- +1 KILL ^UTILITY($JOB)
- +2 IF '$DATA(^TMP($JOB,"BADEN"))
- Begin DoDot:1
- +3 SET ^UTILITY($JOB,1)="No means test records found where the CURRENT MEANS TEST STATUS field (#.14)"
- +4 SET ^UTILITY($JOB,2)="of the PATIENT file (#2) was populated without a corresponding"
- +5 SET ^UTILITY($JOB,3)="Means Test on file."
- End DoDot:1
- +6 IF $DATA(^TMP($JOB,"BADEN"))
- Begin DoDot:1
- +7 SET ^UTILITY($JOB,1)="The following patients had the CURRENT MEANS TEST STATUS field (#.14)"
- +8 SET ^UTILITY($JOB,2)="of the PATIENT file (#2) populated; however, there was no"
- +9 SET ^UTILITY($JOB,3)="corresponding Means Test on File. The PATIENT file has been"
- +10 SET ^UTILITY($JOB,4)="updated."
- +11 SET ^UTILITY($JOB,5)=" "
- +12 SET ^UTILITY($JOB,6)=$$BLDSTR("PATIENT NAME","SSN","CURRENT MT STATUS","")
- +13 SET ^UTILITY($JOB,7)=$$BLDSTR("------------","---","-----------------","")
- +14 NEW DGDFN,DPTSTAT,NM,NM1,LST4,DPTS,P1,P2,P3,P4
- +15 SET (DGDFN,DPTSTAT)=""
- +16 FOR I=8:1
- SET DGDFN=$ORDER(^TMP($JOB,"BADEN",DGDFN))
- IF '+DGDFN
- QUIT
- SET DPTSTAT=""
- FOR
- SET DPTSTAT=$ORDER(^TMP($JOB,"BADEN",DGDFN,DPTSTAT))
- IF DPTSTAT=""
- QUIT
- Begin DoDot:2
- +17 SET NM=$PIECE($GET(^DPT(DGDFN,0)),U)
- SET NM1=$EXTRACT($GET(NM),1,15)
- +18 SET LST4=$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),6,9)
- +19 SET DPTS=$PIECE($GET(^DG(408.32,DPTSTAT,0)),U,1)
- SET DPTS=$EXTRACT($GET(DPTS),1,15)
- +20 SET P1=NM1
- SET P2=LST4
- SET P3=DPTS
- SET P4=""
- +21 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
- +22 QUIT
- End DoDot:2
- +23 QUIT
- End DoDot:1
- +24 NEW DIFROM,%,Y
- +25 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +26 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +27 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +28 SET XMSUB="DG*5.3*358 POST INSTALL - Phase III report "_Y
- +29 SET XMTEXT="^UTILITY($J,"
- +30 DO ^XMD
- +31 DO BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- +32 KILL ^TMP($JOB,"BADEN"),^UTILITY($JOB)
- +33 QUIT
- DOAN ; Phase IV Process Reporting
- +1 ;
- +2 ; This reporting mechanism is broken down into 2 distinct parts.
- +3 ;
- +4 ; 1. An email will be generated on those patients that were in a NLR
- +5 ; status and the date of the test was > than the date of death. The
- +6 ; tests meeting those criteria were treated as invalid and purged.
- +7 ;
- +8 ; 2. An email will be generated for those test in an NLR status on
- +9 ; expired patients where the date of the test was on or before the
- +10 ; date of death. These test statii were recalculated to what they
- +11 ; were prior to date of death.
- +12 ;
- +13 ; PART I
- +14 IF '$DATA(^TMP($JOB,"NLR-DEL"))
- Begin DoDot:1
- +15 SET ^UTILITY($JOB,1)="No means test records were found in a status of 'NO LONGER REQUIRED'"
- +16 SET ^UTILITY($JOB,2)="where the date of the test is greater than the date of death."
- End DoDot:1
- +17 IF $DATA(^TMP($JOB,"NLR-DEL"))
- Begin DoDot:1
- +18 SET ^UTILITY($JOB,1)="The following means tests were found in a status of 'NO LONGER REQUIRED'"
- +19 SET ^UTILITY($JOB,2)="and the test date was entered after the date of death. These tests"
- +20 SET ^UTILITY($JOB,3)="are considered to be invalid and have been purged."
- +21 SET ^UTILITY($JOB,4)=" "
- +22 SET ^UTILITY($JOB,5)=$$BLDSTR("PATIENT NAME","SSN","DATE OF DEATH","DATE OF TEST")
- +23 SET ^UTILITY($JOB,6)=$$BLDSTR("------------","---","-------------","------------")
- +24 NEW DGDFN,DGMTI,DGDOD,DGMTS,DOD,DOT,DOT1,DGDFN1
- +25 SET (DGDFN,DGMTI,DGDFN1)=""
- +26 FOR I=8:1
- SET DGDFN1=$ORDER(^TMP($JOB,"NLR-DEL",DGDFN1))
- IF '+DGDFN1
- QUIT
- Begin DoDot:2
- +27 SET DGDFN=$PIECE($GET(DGDFN1),"~~",1)
- SET DGMTI=$PIECE($GET(DGDFN1),"~~",2)
- +28 SET NM=$PIECE($GET(^DPT(DGDFN,0)),U,1)
- SET NM1=$EXTRACT($GET(NM),1,15)
- +29 SET LST4=$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),6,9)
- +30 SET DOT=$PIECE($GET(^TMP($JOB,"NLR-DEL",DGDFN1)),U,1)
- +31 SET Y=DOT
- XECUTE ^DD("DD")
- SET DOT1=Y
- +32 SET DOD=$PIECE($GET(^DPT(DGDFN,.35)),U)
- SET Y=$PIECE($GET(DOD),".",1)
- +33 XECUTE ^DD("DD")
- SET DGDOD=Y
- +34 SET P1=NM1
- SET P2=LST4
- SET P3=DGDOD
- SET P4=DOT1
- +35 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
- +36 QUIT
- End DoDot:2
- +37 QUIT
- End DoDot:1
- +38 NEW DIFROM,%,Y
- +39 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +40 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +41 SET XMTEXT="^UTILITY($J,"
- +42 NEW %,Y
- +43 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +44 SET XMSUB="DG*5.3*358 POST INSTALL - PHASE IV (PART 1) "_Y
- +45 DO ^XMD
- +46 DO MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- +47 KILL ^UTILITY($JOB),^TMP($JOB,"NLR-DEL")
- +48 ;
- P2 ; PART 2
- +1 IF '$DATA(^TMP($JOB,"RECALC"))
- Begin DoDot:1
- +2 SET ^UTILITY($JOB,1)="No means test records found where the status is 'NO LONGER REQUIRED'"
- +3 SET ^UTILITY($JOB,2)="and the test date is on or before the date of death."
- End DoDot:1
- +4 IF $DATA(^TMP($JOB,"RECALC"))
- Begin DoDot:1
- +5 NEW OLDSTAT,NEWSTAT,DGDFN,NEWCAT,OLDCAT,PID,TDATE,TDATE1,DGDFN1
- +6 SET (OLDSTAT,NEWSTAT,DGDFN,DGDFN1)=""
- +7 SET ^UTILITY($JOB,1)="The following patients have expired and had a means test"
- +8 SET ^UTILITY($JOB,2)="on file in a status of 'NO LONGER REQUIRED'. The test"
- +9 SET ^UTILITY($JOB,3)="dates are on or prior to the date of death; therefore, the status"
- +10 SET ^UTILITY($JOB,4)="has been recalculated to reflect the status at the time of"
- +11 SET ^UTILITY($JOB,5)="death."
- +12 SET ^UTILITY($JOB,6)=" "
- +13 SET ^UTILITY($JOB,7)=$$BLDSTR("PATIENT SSN","TEST DATE","OLD STATUS","NEW STATUS")
- +14 SET ^UTILITY($JOB,8)=$$BLDSTR("----------","---------","----------","----------")
- +15 FOR I=9:1
- SET DGDFN1=$ORDER(^TMP($JOB,"RECALC",DGDFN1))
- IF '+DGDFN1
- QUIT
- Begin DoDot:2
- +16 SET DGDFN=$PIECE($GET(DGDFN1),"~~",1)
- SET TDATE=$PIECE($GET(DGDFN1),"~~",2)
- +17 SET PID=$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),1,3)_"-"_$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),4,5)_"-"_$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),6,9)
- +18 SET Y=TDATE
- XECUTE ^DD("DD")
- SET TDATE1=Y
- +19 SET OLDCAT=$PIECE($GET(^TMP($JOB,"RECALC",DGDFN1)),U,1)
- +20 SET NEWCAT=$PIECE($GET(^TMP($JOB,"RECALC",DGDFN1)),U,2)
- +21 SET P1=PID
- SET P2=TDATE1
- SET P3=OLDCAT
- SET P4=NEWCAT
- +22 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
- +23 QUIT
- End DoDot:2
- +24 QUIT
- End DoDot:1
- +25 NEW DIFROM,%,Y
- +26 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +27 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +28 SET XMTEXT="^UTILITY($J,"
- +29 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +30 SET XMSUB="DG*5.3*358 POST INSTALL - Phase IV (Part II) "_Y
- +31 DO ^XMD
- +32 DO MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
- +33 KILL ^UTILITY($JOB),^TMP($JOB,"RECALC")
- +34 QUIT
- BLDSTR(P1,P2,P3,P4) ; Build a string from input
- +1 NEW S1,S2,S3,S4
- +2 SET S1=$EXTRACT(P1,1,15)
- IF $LENGTH(S1)'>14
- Begin DoDot:1
- +3 SET S1=S1_$JUSTIFY("",(15-$LENGTH(S1)))
- End DoDot:1
- +4 SET S2=P2
- +5 SET S3=$EXTRACT(P3,1,15)
- IF $LENGTH(S3)'>14
- Begin DoDot:1
- +6 SET S3=S3_$JUSTIFY("",(15-$LENGTH(S3)))
- End DoDot:1
- +7 SET S4=$EXTRACT(P4,1,15)
- IF $LENGTH(S4)'>14
- Begin DoDot:1
- +8 SET S4=S4_$JUSTIFY("",(15-$LENGTH(S4)))
- End DoDot:1
- +9 QUIT S1_$JUSTIFY("",5)_S2_$JUSTIFY("",5)_S3_$JUSTIFY("",5)_S4
