- DG53461U ;ALB/AEG - DG*5.3*461 POST INSTALL UTILS ;7-3-02
- ;;5.3;Registration;**461,1015**;Aug 13, 1993;Build 21
- ;
- MESS ; Setup initial message array for users
- S MESS(1)="This post-installation will search the CD STATUS PROCECURES subfile (#.397)"
- S MESS(2)="of the PATIENT file (#2) to find those patients who have duplicate procedure"
- S MESS(3)="codes associated with the same extremity. The duplicate entries will be purged"
- S MESS(4)="from the CD STATUS PROCEDURES subfile (#.397). A report will be generated"
- S MESS(5)="via mailman to identify the patient and the data values of the duplicate"
- S MESS(6)="procedures and associated extremities purged from the database."
- S MESS(7)=" "
- Q
- M1 ; Send mail message if no duplicate data to be cleaned up by the patch.
- ;
- S ^TMP($J,1)="No duplicate CD procedure codes found in your database."
- N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
- S XMSUB="DG*5.3*461 POST INSTALL REPORT"
- S XMY(DUZ)="",XMY(.5)="",XMDUZ="REGISTRATION PACKAGE"
- S XMTEXT="^TMP($J,"
- D ^XMD
- D BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
- K ^TMP($J)
- Q
- ;
- M2 ; Setup mail message to report patient data/procedure data of purged
- ; data to users.
- I '$D(^UTILITY($J,"DUP")) Q
- S ^TMP($J,1)="The following patients had duplicate CD procedures in the CD STATUS PROCEDURES"
- S ^TMP($J,2)="subfile (#.397) of the PATIENT file (#2). The duplicate procedures have been"
- S ^TMP($J,3)="purged from your database."
- S ^TMP($J,4)=" "
- S ^TMP($J,5)=$$BLDSTR("PATIENT NAME","LAST 4","CD PROCEDURE","EXTREMITY")
- S ^TMP($J,6)=$$BLDSTR("------------","------","------------","---------")
- N NAME,SSN,PROC,EXT,AJ,DFN,PCODE,COUNTER,N1
- S NAME="",COUNTER=6,N1=""
- F AJ=7:1 S NAME=$O(^UTILITY($J,"DUP",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^UTILITY($J,"DUP",NAME,DFN)) Q:'+DFN D
- .S SSN=$E($P($G(^DPT(DFN,0)),U,9),6,9)
- .S N1=NAME
- .S PCODE="" F S PCODE=$O(^UTILITY($J,"DUP",NAME,DFN,PCODE)) Q:PCODE="" S COUNTER=COUNTER+1 D
- ..S PROC=$P($G(PCODE),"^",1)
- ..S PROC=$G(^DGEN(27.17,PROC,0)),PROC=$P($P($G(PROC),U,3),";",1)
- ..S EXT=$P($G(PCODE),U,2)
- ..I $G(^TMP($J,COUNTER-1))[NAME S (N1,SSN)=""
- ..S ^TMP($J,COUNTER)=$$BLDSTR(N1,SSN,PROC,EXT)
- ..Q
- .Q
- N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
- S XMSUB="DG*5.3*461 POST INSTALL REPORT"
- S XMY(DUZ)="",XMY(.5)="",XMDUZ="REGISTRATION PACKAGE"
- S XMTEXT="^TMP($J,"
- D ^XMD
- D BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
- K ^TMP($J),^UTILITY($J)
- Q
- M3 ; Report any errors to user if duplicate CD STATUS PROCEDURE could not
- ; be purged from the system.
- N DFN,ERR,NAME,SSN,AK
- S ^TMP($J,1)="The following patients have duplicate CD Procedure codes which could not"
- S ^TMP($J,2)="be purged from the database due to errors. Please review this list"
- S ^TMP($J,3)="and make corrections to the patient's Catastrophic disability as"
- S ^TMP($J,4)="necessary."
- S ^TMP($J,5)=""
- S ^TMP($J,6)=$$BLDSTR("PATIENT NAME","LAST 4","ERROR","")
- S ^TMP($J,7)=$$BLDSTR("------------","------","-----","")
- N ERR,DFN,SSN
- S DFN=""
- F AK=8:1 S DFN=$O(^TMP("ERROR",$J,DFN)) Q:'+DFN D
- .S NAME=$E($P($G(^DPT(DFN,0)),U,1),1,20)
- .S SSN=$E($P($G(^DPT(DFN,0)),U,9),6,9)
- .S ERR="" F S ERR=$O(^TMP("ERROR",$J,DFN,ERR)) Q:ERR="" D
- ..S ^TMP($J,AK)=$$BLDSTR(NAME,SSN,ERR,"")
- ..Q
- .Q
- N DIFROM,%,XMDUZ,XMTEXT,XMY,Y
- S XMSUB="DG*5.3*461 POST INSTALL ERROR REPORT"
- S XMY(DUZ)="",XMY(.5)="",XMDUZ="REGISTRATION PACKAGE"
- S XMTEXT="^TMP($J,"
- D ^XMD
- D BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
- K ^TMP($J),^UTILITY($J),^TMP("ERROR",$J)
- Q
- BLDSTR(P1,P2,P3,P4) ; Build a string from input
- N S1,S2,S3,S4
- S S1=$E(P1,1,20) I $L(S1)'>19 D
- .S S1=S1_$J("",(20-$L(S1)))
- S S2=P2 I $L(S2)'>6 D
- .S S2=S2_$J("",(7-$L(S2)))
- S S3=P3 I $L(S3)'>11 D
- .S S3=S3_$J("",(12-$L(S3)))
- S S4=P4
- Q S1_$J("",3)_S2_$J("",5)_S3_$J("",5)_S4
- DG53461U ;ALB/AEG - DG*5.3*461 POST INSTALL UTILS ;7-3-02
- +1 ;;5.3;Registration;**461,1015**;Aug 13, 1993;Build 21
- +2 ;
- MESS ; Setup initial message array for users
- +1 SET MESS(1)="This post-installation will search the CD STATUS PROCECURES subfile (#.397)"
- +2 SET MESS(2)="of the PATIENT file (#2) to find those patients who have duplicate procedure"
- +3 SET MESS(3)="codes associated with the same extremity. The duplicate entries will be purged"
- +4 SET MESS(4)="from the CD STATUS PROCEDURES subfile (#.397). A report will be generated"
- +5 SET MESS(5)="via mailman to identify the patient and the data values of the duplicate"
- +6 SET MESS(6)="procedures and associated extremities purged from the database."
- +7 SET MESS(7)=" "
- +8 QUIT
- M1 ; Send mail message if no duplicate data to be cleaned up by the patch.
- +1 ;
- +2 SET ^TMP($JOB,1)="No duplicate CD procedure codes found in your database."
- +3 NEW DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
- +4 SET XMSUB="DG*5.3*461 POST INSTALL REPORT"
- +5 SET XMY(DUZ)=""
- SET XMY(.5)=""
- SET XMDUZ="REGISTRATION PACKAGE"
- +6 SET XMTEXT="^TMP($J,"
- +7 DO ^XMD
- +8 DO BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
- +9 KILL ^TMP($JOB)
- +10 QUIT
- +11 ;
- M2 ; Setup mail message to report patient data/procedure data of purged
- +1 ; data to users.
- +2 IF '$DATA(^UTILITY($JOB,"DUP"))
- QUIT
- +3 SET ^TMP($JOB,1)="The following patients had duplicate CD procedures in the CD STATUS PROCEDURES"
- +4 SET ^TMP($JOB,2)="subfile (#.397) of the PATIENT file (#2). The duplicate procedures have been"
- +5 SET ^TMP($JOB,3)="purged from your database."
- +6 SET ^TMP($JOB,4)=" "
- +7 SET ^TMP($JOB,5)=$$BLDSTR("PATIENT NAME","LAST 4","CD PROCEDURE","EXTREMITY")
- +8 SET ^TMP($JOB,6)=$$BLDSTR("------------","------","------------","---------")
- +9 NEW NAME,SSN,PROC,EXT,AJ,DFN,PCODE,COUNTER,N1
- +10 SET NAME=""
- SET COUNTER=6
- SET N1=""
- +11 FOR AJ=7:1
- SET NAME=$ORDER(^UTILITY($JOB,"DUP",NAME))
- IF NAME=""
- QUIT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^UTILITY($JOB,"DUP",NAME,DFN))
- IF '+DFN
- QUIT
- Begin DoDot:1
- +12 SET SSN=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
- +13 SET N1=NAME
- +14 SET PCODE=""
- FOR
- SET PCODE=$ORDER(^UTILITY($JOB,"DUP",NAME,DFN,PCODE))
- IF PCODE=""
- QUIT
- SET COUNTER=COUNTER+1
- Begin DoDot:2
- +15 SET PROC=$PIECE($GET(PCODE),"^",1)
- +16 SET PROC=$GET(^DGEN(27.17,PROC,0))
- SET PROC=$PIECE($PIECE($GET(PROC),U,3),";",1)
- +17 SET EXT=$PIECE($GET(PCODE),U,2)
- +18 IF $GET(^TMP($JOB,COUNTER-1))[NAME
- SET (N1,SSN)=""
- +19 SET ^TMP($JOB,COUNTER)=$$BLDSTR(N1,SSN,PROC,EXT)
- +20 QUIT
- End DoDot:2
- +21 QUIT
- End DoDot:1
- +22 NEW DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
- +23 SET XMSUB="DG*5.3*461 POST INSTALL REPORT"
- +24 SET XMY(DUZ)=""
- SET XMY(.5)=""
- SET XMDUZ="REGISTRATION PACKAGE"
- +25 SET XMTEXT="^TMP($J,"
- +26 DO ^XMD
- +27 DO BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
- +28 KILL ^TMP($JOB),^UTILITY($JOB)
- +29 QUIT
- M3 ; Report any errors to user if duplicate CD STATUS PROCEDURE could not
- +1 ; be purged from the system.
- +2 NEW DFN,ERR,NAME,SSN,AK
- +3 SET ^TMP($JOB,1)="The following patients have duplicate CD Procedure codes which could not"
- +4 SET ^TMP($JOB,2)="be purged from the database due to errors. Please review this list"
- +5 SET ^TMP($JOB,3)="and make corrections to the patient's Catastrophic disability as"
- +6 SET ^TMP($JOB,4)="necessary."
- +7 SET ^TMP($JOB,5)=""
- +8 SET ^TMP($JOB,6)=$$BLDSTR("PATIENT NAME","LAST 4","ERROR","")
- +9 SET ^TMP($JOB,7)=$$BLDSTR("------------","------","-----","")
- +10 NEW ERR,DFN,SSN
- +11 SET DFN=""
- +12 FOR AK=8:1
- SET DFN=$ORDER(^TMP("ERROR",$JOB,DFN))
- IF '+DFN
- QUIT
- Begin DoDot:1
- +13 SET NAME=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,1),1,20)
- +14 SET SSN=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
- +15 SET ERR=""
- FOR
- SET ERR=$ORDER(^TMP("ERROR",$JOB,DFN,ERR))
- IF ERR=""
- QUIT
- Begin DoDot:2
- +16 SET ^TMP($JOB,AK)=$$BLDSTR(NAME,SSN,ERR,"")
- +17 QUIT
- End DoDot:2
- +18 QUIT
- End DoDot:1
- +19 NEW DIFROM,%,XMDUZ,XMTEXT,XMY,Y
- +20 SET XMSUB="DG*5.3*461 POST INSTALL ERROR REPORT"
- +21 SET XMY(DUZ)=""
- SET XMY(.5)=""
- SET XMDUZ="REGISTRATION PACKAGE"
- +22 SET XMTEXT="^TMP($J,"
- +23 DO ^XMD
- +24 DO BMES^XPDUTL("Post-Install Message <"_XMZ_"> sent.")
- +25 KILL ^TMP($JOB),^UTILITY($JOB),^TMP("ERROR",$JOB)
- +26 QUIT
- BLDSTR(P1,P2,P3,P4) ; Build a string from input
- +1 NEW S1,S2,S3,S4
- +2 SET S1=$EXTRACT(P1,1,20)
- IF $LENGTH(S1)'>19
- Begin DoDot:1
- +3 SET S1=S1_$JUSTIFY("",(20-$LENGTH(S1)))
- End DoDot:1
- +4 SET S2=P2
- IF $LENGTH(S2)'>6
- Begin DoDot:1
- +5 SET S2=S2_$JUSTIFY("",(7-$LENGTH(S2)))
- End DoDot:1
- +6 SET S3=P3
- IF $LENGTH(S3)'>11
- Begin DoDot:1
- +7 SET S3=S3_$JUSTIFY("",(12-$LENGTH(S3)))
- End DoDot:1
- +8 SET S4=P4
- +9 QUIT S1_$JUSTIFY("",3)_S2_$JUSTIFY("",5)_S3_$JUSTIFY("",5)_S4