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

SDRRC20.m

Go to the documentation of this file.
  1. SDRRC20 ;10N20/MAH - ENV/POST-INSTALL FOR PATCH SD*5.3*536 CONVERT PATIENT FILE ; 3/01/2008 12:24pm
  1. ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
  1. ;;SDRR-RECALL REMINDER
  1. Q
  1. ENV ;Environment check
  1. K ^XTMP("SDRRC20")
  1. S XPDABORT=""
  1. ;checks programmer variables
  1. D PROGCHK(.XPDABORT)
  1. ;check if install is running
  1. D ISRUNING(.XPDABORT)
  1. I XPDABORT="" K XPDABORT
  1. POST ;Check for Clinic Recall PATIENTs file)
  1. I '$D(^DIZ(687065)) D Q
  1. . D NOFILE
  1. D CHECKDD
  1. I DDISSUE=1 K DDISSUE,PFLAG,PFLAG1 Q
  1. K DDISSUE,PFLAG,PFLAG1
  1. D TASK
  1. Q
  1. START ;Background job entry point
  1. N SDAIEN,SDANUSB,SDX,SDFDAIEN,SDARAY,SDERAY,SDSAVE,SDRRREC,SDRRFDA,TOTAL
  1. N SDTOT,SDTOT2,SDTOT3,SDENCPTR,SDCKCNT,SDRRSTOP,SDENT,SDFIL,DFN,PATIENT
  1. S TOTAL=0
  1. D XTMP
  1. ;seed var's if Re-Run
  1. I $D(^XTMP("SDRRC20","TOT")) D
  1. . S SDTOT=+$G(^XTMP("SDRRC20","TOT"))
  1. . S (SDSAVE,SDAIEN)=+$G(^XTMP("SDRRC20","PATIENT"))
  1. E D
  1. . S SDAIEN=0 F S SDAIEN=$O(^DIZ(687065,SDAIEN)) Q:SDAIEN<1 S SDRRREC=$G(^DIZ(687065,SDAIEN,0)) D
  1. . .Q:$P($G(SDRRREC),U,6)=""
  1. . .S SDRRFDA(403.5,"+1,",.01)=$P(SDRRREC,U,1)
  1. . .S SDRRFDA(403.5,"+1,",2)=$P(SDRRREC,U,3)
  1. . .S SDRRFDA(403.5,"+1,",2.5)=$P(SDRRREC,U,7)
  1. . .S SDRRFDA(403.5,"+1,",2.6)=$P(SDRRREC,U,8)
  1. . .I $P($G(SDRRREC),U,4)'="" S SDRRFDA(403.5,"+1,",3)=$P($G(SDRRREC),U,4)
  1. . .I $P($G(SDRRREC),U,5)'="" S SDRRFDA(403.5,"+1,",4)=$P($G(SDRRREC),U,5)
  1. . .I $P($G(SDRRREC),U,2)'="" S SDRRFDA(403.5,"+1,",4.5)=$P($G(SDRRREC),U,2)
  1. . .I $P($G(SDRRREC),U,9)'="" S SDRRFDA(403.5,"+1,",4.7)=$P($G(SDRRREC),U,9)
  1. . .S SDRRFDA(403.5,"+1,",5)=$P($G(SDRRREC),U,6)
  1. . .I $P($G(SDRRREC),U,10)'="" S SDRRFDA(403.5,"+1,",6)=$P($G(SDRRREC),U,10)
  1. . .I $P($G(SDRRREC),U,11)'="" S SDRRFDA(403.5,"+1,",7)=$P($G(SDRRREC),U,11) ;WILL STUFF PROGRAMMER DUZ IF NOT ALREADY SET
  1. . .N NEWREC S NEWREC(1)=SDAIEN
  1. . .D UPDATE^DIE("","SDRRFDA","NEWREC")
  1. . .S TOTAL=TOTAL+1
  1. S ^XTMP("SDRRC20","COMPLETED")=$$NOW^XLFDT()
  1. S ^XTMP("SDRRC20","TOT")=TOTAL
  1. K ^XTMP("SDRRC20","RUNNING")
  1. D SENDMSG
  1. Q
  1. SENDMSG ;send MailMan msg to patch installer
  1. N DIFROM,SDMSG,SDTXT,SDLN,XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ
  1. K ^TMP("SDRRC20",$J)
  1. S XMSUB="SD*5.3*536 OUTPATIENT CLINIC RECALL FILE CONVERSION REPORT"
  1. S XMTEXT="^TMP(""SDRRC20"",$J,",XMDUZ=.5,(XMY(DUZ),XMY(XMDUZ))=""
  1. S SDLN=0
  1. D ADD(.SDLN,"Patch: SD*5.3*536 RECALL REMINDER FILE CONVERSION PROCESSING")
  1. D ADD(.SDLN," "),ADD(.SDLN,"************")
  1. D ADD(.SDLN,"The existing Class III file called OUTPATIENT CLINIC RECALL (687065), ")
  1. D ADD(.SDLN,"which contains Clinic Recall ENTRIES have been converted to")
  1. D ADD(.SDLN,"a new Class I file called Recall Reminder (403.5)")
  1. D ADD(.SDLN,"which will provide the same functionality. If you have added")
  1. D ADD(.SDLN,"any local site field to file 687065 they will not be moved over.")
  1. D ADD(.SDLN,"************"),ADD(.SDLN," "),ADD(.SDLN," ")
  1. D ADD(.SDLN,"SUMMARY OF PROCESSING RESULTS:")
  1. D ADD(.SDLN,"==============================")
  1. D ADD(.SDLN," ")
  1. D ADD(.SDLN,"<<< The Class III OUTPATIENT CLINIC RECALL PATIENT File Conversion has "_$S(+$G(SDRRSTOP):"NOT ",1:"")_"Completed. >>>")
  1. I +$G(SDRRSTOP) D
  1. . D ADD(.SDLN," Please restart the post-install process from the following")
  1. . D ADD(.SDLN," programmer's prompt:")
  1. . D ADD(.SDLN," D POST^SDRRC20")
  1. D ADD(.SDLN," "),ADD(.SDLN," ")
  1. D ADD(.SDLN," DATE/TIME TASK STARTED: "_$$FMTE^XLFDT(+$G(^XTMP("SDRRC20","START")),"P"))
  1. D ADD(.SDLN,"DATE/TIME TASK COMPLETED: "_$$FMTE^XLFDT(+$G(^XTMP("SDRRC20","COMPLETED")),"P"))
  1. I $D(^XTMP("SDRRC20","LAST RUN")) D
  1. . D ADD(.SDLN," DATE/TIME LAST RUN: "_$$FMTE^XLFDT(+$G(^XTMP("SDRRC20","LAST RUN")),"P"))
  1. D ADD(.SDLN," "),ADD(.SDLN," ")
  1. D ADD(.SDLN," TOTAL RECORDS THAT HAVE BEEN CONVERTED: "_+$G(^XTMP("SDRRC20","TOT")))
  1. D ADD(.SDLN," <END OF REPORT> :")
  1. D ^XMD
  1. K ^TMP("SDRRC20",$J)
  1. Q
  1. ADD(SDLN,SDTXT) ;add line
  1. Q:$L(SDTXT)'>0
  1. S SDLN=$G(SDLN)+1
  1. S ^TMP("SDRRC20",$J,SDLN)=SDTXT
  1. Q
  1. PROGCHK(XPDABORT) ;checks programmer variables
  1. I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
  1. . D BMES^XPDUTL("******")
  1. . D MES^XPDUTL("Your programming variables are not set up properly.")
  1. . D MES^XPDUTL("Installation aborted.")
  1. . D MES^XPDUTL("******")
  1. . S XPDABORT=2
  1. Q
  1. ISRUNING(XPDABORT) ;check if running
  1. I +$G(^XTMP("SDRRC20","RUNNING")) D
  1. . D BMES^XPDUTL("******")
  1. . D MES^XPDUTL("This patch is currently being Installed. Try later.")
  1. . D MES^XPDUTL("Installation aborted...")
  1. . D MES^XPDUTL("******")
  1. . S XPDABORT=2
  1. Q
  1. NOFILE ;no File
  1. D BMES^XPDUTL("******")
  1. D MES^XPDUTL("The Class III Outpatient Clinic Recall File Conversion is NOT necessary because")
  1. D MES^XPDUTL("file (#687065) does not exist on this system.")
  1. D MES^XPDUTL("Post-Install process terminated...For conversion to Recall Reminder PATIENT (#403.5)")
  1. D MES^XPDUTL("******")
  1. Q
  1. TASK ;run TaskMan
  1. N ZTSK,ZTDTH,ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTREQ,ZTSTOP,SDSTOP
  1. S SDSTOP=+$G(^XTMP("SDRRC20","STOPPED"))
  1. S ZTRTN="START^SDRRC20"
  1. S ZTDESC="SD*5.3*536 RECALL REMINDER PATIENT FILE CONVERSION PROCESSING"
  1. S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")=""
  1. D ^%ZTLOAD
  1. D BMES^XPDUTL("******")
  1. I '$D(ZTSK) D
  1. . D MES^XPDUTL("Unable to schedule TaskMan task to run the Class III (687065) File")
  1. . D MES^XPDUTL("Conversion.")
  1. . D BMES^XPDUTL("Please re-run Post-Install routine POST^SDRRC20 from")
  1. . D MES^XPDUTL("the programmer prompt.")
  1. . ;
  1. E D
  1. . D MES^XPDUTL("Task "_ZTSK_" has been "_$S(+SDSTOP:"Re-",1:"")_"started to run the Class III (687065) File")
  1. . D MES^XPDUTL("Conversion.")
  1. . I SDSTOP D
  1. . . D MES^XPDUTL(" <<< The last task run was STOPPED on "_$$FMTE^XLFDT(SDSTOP,"P")_". >>>")
  1. . D BMES^XPDUTL("You will receive a MailMan message when this task is completed")
  1. . D MES^XPDUTL("or if it has been manually stopped.")
  1. D MES^XPDUTL("******")
  1. Q
  1. XTMP ;setup ^XTMP to control output for 90 days
  1. I $D(^XTMP("SDRRC20",0)) D
  1. . S ^XTMP("SDRRC20","LAST RUN")=$G(^XTMP("SDRRC20","START"))
  1. E D
  1. . N SDX
  1. . S SDX=$$FMADD^XLFDT($$NOW^XLFDT(),90)_U_$$NOW^XLFDT()
  1. . S SDX=SDX_"^SD*5.3*536 RECALL REMINDER PATIENT FILE CONVERSION PROCESSING"
  1. . S ^XTMP("SDRRC20",0)=SDX
  1. S ^XTMP("SDRRC20","START")=$$NOW^XLFDT()
  1. S ^XTMP("SDRRC20","RUNNING")="1"
  1. Q
  1. UPXTMP(SDENCPTR,NODE,SDENT) ;add to ^XTMP
  1. ; Input:
  1. ; NODE - Unique subscript
  1. ; Output: none
  1. Q:'$G(SDENCPTR)
  1. I $G(NODE)="" S NODE="UNKNOWN"
  1. S ^XTMP("SDRRC20","TOT2",NODE,SDENCPTR)=$G(SDENT)
  1. Q
  1. CHECKDD ;CHECKS CURRENT FIELDS IN 687065
  1. S (DDISSUE,PFLAG,PFLAG1)=""
  1. S PFLAG=$P(^DD(687065,.01,0),U,2) I PFLAG'["RP2'" S DDISSUE=1 W !,"1 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,2,0),U,2) I PFLAG'["F" S DDISSUE=1 W !,"2 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,2.5,0),U,2) I PFLAG'["F" S DDISSUE=1 W !,"3 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,2.6,0),U,2),PFLAG1=$P(^DD(687065,2.6,0),U,3) I PFLAG'["S"!(PFLAG1'["f:FASTING;n:NON-FASTING") S DDISSUE=1 W !,"4 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,3,0),U,2) I PFLAG'["RP653204'" S DDISSUE=1 W !,"5 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,4,0),U,2) I PFLAG'["RP687067'" S DDISSUE=1 W !,"6 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,4.5,0),U,2) I PFLAG'["P44'" S DDISSUE=1 W !,"7 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,4.7,0),U,2) I PFLAG'["NJ3,0" S DDISSUE=1 W !,"8 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,5,0),U,2) I PFLAG'["RD" S DDISSUE=1 W !,"9 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,6,0),U,2) I PFLAG'["D" S DDISSUE=1 W !,"10 "_PFLAG G NOENTRY
  1. S PFLAG=$P(^DD(687065,7,0),U,2) I PFLAG'["P200'" S DDISSUE=1 W !,"11 "_PFLAG G NOENTRY
  1. Q
  1. NOENTRY ;no File
  1. D BMES^XPDUTL("******")
  1. D MES^XPDUTL("The Class III Outpatient Clinic Recall File Conversion WILL NOT happen because")
  1. D MES^XPDUTL("file (#687065) has DD changes to needed fields.")
  1. D MES^XPDUTL("Post-Install process terminated...For conversion to Recall Reminder(#403.5)")
  1. D MES^XPDUTL("******")
  1. Q