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

PXVP215.m

Go to the documentation of this file. 
  1. PXVP215 ;BPFO/LMT - PX*1*215 KIDS Routine ;04/05/2016
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
  1.  ;
  1. POST ; KIDS Post install for PX*1*215
  1.  D BMES("*** Post install started ***")
  1.  ;
  1.  S DIU=9000010.123,DIU(0)="S" D EN^DIU2 K DIU ; Delete Coding System multiple from file #9000010.12
  1.  D CODEMAP ; Generate PCE Code Mapping Report
  1.  D LOAD9206 ; Populate data for #920.6
  1.  ;
  1.  D BMES("*** Post install completed ***")
  1.  Q
  1.  ;
  1.  ;---------------------------------------------------------------------
  1. CODEMAP ; Generate PCE Code Mapping Report
  1.  ;
  1.  N PXERRLN,PXERRNUM,PXERRTXT,PXFROM,PXFROMEN,PXIEN,PXIMM,PXINCLUDE,PXINST,PXINSTNAME,PXINSTNUM
  1.  N PXINSTR,PXLINE,PXMGROUP,PXMSGSUB,PXMSGTO,PXNODE,PXREMMGIEN,PXTO,PXTOEN,XMERR
  1.  ;
  1.  D BMES("*** Generating PCE CODE MAPPING Report ***")
  1.  ;
  1.  K ^TMP("PX215PCM",$J)
  1.  ;
  1.  S PXINST=$$KSP^XUPARAM("INST")
  1.  S PXINSTNAME=$$NAME^XUAF4(PXINST)
  1.  S PXINSTNUM=$$STA^XUAF4(PXINST)
  1.  ;
  1.  S PXLINE=10 ; Start at #10, as the preamble part of the message will be in lines 1-10
  1.  ;
  1.  S PXIEN=0
  1.  F  S PXIEN=$O(^PXD(811.1,PXIEN)) Q:'PXIEN  D
  1.  . S PXNODE=$G(^PXD(811.1,PXIEN,0))
  1.  . ;
  1.  . I '$P(PXNODE,U,5) Q
  1.  . ;
  1.  . S PXFROM=$P(PXNODE,U,3)
  1.  . S PXINCLUDE=0
  1.  . I PXFROM="CPT" S PXINCLUDE=1
  1.  . I PXFROM="IMM" D
  1.  . . S PXIMM=+$P(PXNODE,U,1)
  1.  . . I $$IMMSTAT^PXAPIIM(PXIMM)'="A" S PXINCLUDE=1
  1.  . ;
  1.  . I 'PXINCLUDE Q
  1.  . ;
  1.  . S PXFROMEN=+$P(PXNODE,U,1)
  1.  . S PXTOEN=+$P(PXNODE,U,2)
  1.  . S PXTO=$P(PXNODE,U,4)
  1.  . I PXFROM="IMM" S PXFROMEN=$P($G(^AUTTIMM(PXFROMEN,0)),U,1)
  1.  . I PXFROM="CPT" S PXFROMEN=$$CODEC^ICPTCOD(PXFROMEN)
  1.  . I (PXFROMEN="")!(PXFROMEN=-1) Q
  1.  . I PXTO="IMM" S PXTOEN=$P($G(^AUTTIMM(PXTOEN,0)),U,1)
  1.  . I PXTO="CPT" S PXTOEN=$$CODEC^ICPTCOD(PXTOEN)
  1.  . S ^TMP("PX215PCM",$J,$$LINE())=PXINSTNUM_U_PXINSTNAME_U_PXFROM_U_PXFROMEN_U_PXTO_U_PXTOEN
  1.  ;
  1.  I '$D(^TMP("PX215PCM",$J)) D  Q
  1.  . D MES("No entries to report.")
  1.  ;
  1.  S ^TMP("PX215PCM",$J,1)="This report was generated by the PX*1*215 Post-Install. It contains a list of"
  1.  S ^TMP("PX215PCM",$J,3)="entries from the PCE CODE MAPPING file (#811.1) for your review."
  1.  S ^TMP("PX215PCM",$J,4)=" "
  1.  S ^TMP("PX215PCM",$J,5)="This report lists entries where both: "
  1.  S ^TMP("PX215PCM",$J,6)="   1. The FROM field (#.03) equals ""CPT"" OR the immunization in the File Entry"
  1.  S ^TMP("PX215PCM",$J,7)="      field (#.01) is inactive."
  1.  S ^TMP("PX215PCM",$J,8)="   2. And the ON/OFF FLAG field (#.05) equals ""ON""."
  1.  S ^TMP("PX215PCM",$J,9)=" "
  1.  S ^TMP("PX215PCM",$J,10)="Station #^Station Name^From^From Code^To^To Code"
  1.  ;
  1.  S PXMSGSUB=PXINSTNUM_" PCE CODE MAPPING DATA FOR REVIEW"
  1.  S PXMSGTO(DUZ)=""
  1.  S PXREMMGIEN=$$GET1^DIQ(800,1_",",3)
  1.  I PXREMMGIEN'="" D
  1.  . S PXMGROUP="G."_$$GET1^DIQ(3.8,PXREMMGIEN_",",.01)
  1.  . S PXMSGTO(PXMGROUP)=""
  1.  I $$PROD^XUPROD(),$G(DUZ("AG"))="V" D
  1.  . S PXMSGTO("TEITELBAUM.LEVI@DOMAIN.EXT")=""
  1.  . S PXMSGTO("SILVERMAN.ROBERT@DOMAIN.EXT")=""
  1.  . S PXMSGTO("BRYAN.VOLPP@DOMAIN.EXT")=""
  1.  S PXINSTR("FROM")="PX*1*215 POST-INSTALL"
  1.  S PXINSTR("ADDR FLAGS")="R"
  1.  D SENDMSG^XMXAPI(DUZ,PXMSGSUB,"^TMP(""PX215PCM"",$J)",.PXMSGTO,.PXINSTR,.PXMSGNUM)
  1.  D MES("Emailed report message (#"_$G(PXMSGNUM)_")")
  1.  I $G(XMERR),$D(^TMP("XMERR",$J)) D
  1.  . D MES("The following errors occurred while sending the email:")
  1.  . S PXERRNUM=0
  1.  . F  S PXERRNUM=$O(^TMP("XMERR",$J,PXERRNUM)) Q:'PXERRNUM  D
  1.  . . S PXERRTXT="  "_PXERRNUM_". "
  1.  . . S PXERRLN=0
  1.  . . F  S PXERRLN=$O(^TMP("XMERR",$J,PXERRNUM,"TEXT",PXERRLN)) Q:'PXERRLN  D
  1.  . . . S PXERRTXT=PXERRTXT_$G(^TMP("XMERR",$J,PXERRNUM,"TEXT",PXERRLN))
  1.  . . . D MES(PXERRTXT)
  1.  . . . S PXERRTXT="     "
  1.  ;
  1.  K ^TMP("PX215PCM",$J)
  1.  ;
  1.  Q
  1.  ;
  1. LINE() ;
  1.  S PXLINE=PXLINE+1
  1.  Q PXLINE
  1.  ;-------------------------------------------------------------------------
  1.  ;
  1. LOAD9206 ; Populate data for #920.6
  1.  ;
  1.  N PXERRMSG,PXFDA,PXI,PXIENS,PXROUTE,PXROUTENM,PXROUTES,PXSITE,PXSITEHL,PXSITES
  1.  ;
  1.  D BMES("*** Populating data for #920.6 ***")
  1.  ;
  1.  I $O(^PXV(920.6,0)) D  Q
  1.  . D MES("Data already populated... no need to populate again.")
  1.  ;
  1.  S PXROUTES("INTRADERMAL")="LA^LLFA^LT^RA^RLFA^RT"
  1.  S PXROUTES("PERCUTANEOUS")="LA^LLFA^LT^RA^RLFA^RT"
  1.  S PXROUTES("SUBCUTANEOUS")="LA^LLFA^LT^RA^RLFA^RT"
  1.  S PXROUTES("INTRAMUSCULAR")="LD^LG^LVL^RD^RG^RVL^RVG^LVG"
  1.  S PXROUTES("NASAL")="BN^LN^RN"
  1.  S PXROUTES("ORAL")=""
  1.  ;
  1.  S PXROUTENM=""
  1.  F  S PXROUTENM=$O(PXROUTES(PXROUTENM)) Q:PXROUTENM=""  D
  1.  . K PXFDA,PXERRMSG,PXIENS
  1.  . D CLEAN^DILF
  1.  . ;
  1.  . S PXROUTE=$O(^PXV(920.2,"B",PXROUTENM,0))
  1.  . I 'PXROUTE D  Q
  1.  . . D MES("Can't add mappings for route '"_PXROUTENM_"', as no #920.2 entry was found for it.")
  1.  . ;
  1.  . S PXFDA(1,920.6,"?+1,",.01)=PXROUTE
  1.  . S PXIENS(1)=PXROUTE
  1.  . ;
  1.  . S PXSITES=$G(PXROUTES(PXROUTENM))
  1.  . F PXI=1:1 S PXSITEHL=$P(PXSITES,U,PXI) Q:PXSITEHL=""  D
  1.  . . S PXSITE=$O(^PXV(920.3,"B",PXSITEHL,0))
  1.  . . I 'PXSITE D  Q
  1.  . . . D MES("Can't add site '"_PXSITEHL_"', as no #920.3 entry was found for it.")
  1.  . . ;
  1.  . . S PXFDA(1,920.61,"?+"_(PXI+1)_",?+1,",.01)=PXSITE
  1.  . ;
  1.  . D UPDATE^DIE("","PXFDA(1)","PXIENS")
  1.  . I $D(^TMP("DIERR",$J)) D
  1.  . . D MES("The following errors occurred:")
  1.  . . D MSG^DIALOG("AE",.PXERRMSG)
  1.  . . D MES^XPDUTL(.PXERRMSG)
  1.  . ;
  1.  . K PXFDA,PXERRMSG,PXIENS
  1.  . D CLEAN^DILF
  1.  ;
  1.  Q
  1.  ;
  1.  ;-------------------------------------------------------------------------
  1.  ;
  1. BMES(STR) ;
  1.  ; Write string
  1.  D BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
  1.  Q
  1. MES(STR) ;
  1.  ; Write string
  1.  D MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
  1.  Q