PXVP215 ;BPFO/LMT - PX*1*215 KIDS Routine ;04/05/2016
;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
;
POST ; KIDS Post install for PX*1*215
D BMES("*** Post install started ***")
;
S DIU=9000010.123,DIU(0)="S" D EN^DIU2 K DIU ; Delete Coding System multiple from file #9000010.12
D CODEMAP ; Generate PCE Code Mapping Report
D LOAD9206 ; Populate data for #920.6
;
D BMES("*** Post install completed ***")
Q
;
;---------------------------------------------------------------------
CODEMAP ; Generate PCE Code Mapping Report
;
N PXERRLN,PXERRNUM,PXERRTXT,PXFROM,PXFROMEN,PXIEN,PXIMM,PXINCLUDE,PXINST,PXINSTNAME,PXINSTNUM
N PXINSTR,PXLINE,PXMGROUP,PXMSGSUB,PXMSGTO,PXNODE,PXREMMGIEN,PXTO,PXTOEN,XMERR
;
D BMES("*** Generating PCE CODE MAPPING Report ***")
;
K ^TMP("PX215PCM",$J)
;
S PXINST=$$KSP^XUPARAM("INST")
S PXINSTNAME=$$NAME^XUAF4(PXINST)
S PXINSTNUM=$$STA^XUAF4(PXINST)
;
S PXLINE=10 ; Start at #10, as the preamble part of the message will be in lines 1-10
;
S PXIEN=0
F S PXIEN=$O(^PXD(811.1,PXIEN)) Q:'PXIEN D
. S PXNODE=$G(^PXD(811.1,PXIEN,0))
. ;
. I '$P(PXNODE,U,5) Q
. ;
. S PXFROM=$P(PXNODE,U,3)
. S PXINCLUDE=0
. I PXFROM="CPT" S PXINCLUDE=1
. I PXFROM="IMM" D
. . S PXIMM=+$P(PXNODE,U,1)
. . I $$IMMSTAT^PXAPIIM(PXIMM)'="A" S PXINCLUDE=1
. ;
. I 'PXINCLUDE Q
. ;
. S PXFROMEN=+$P(PXNODE,U,1)
. S PXTOEN=+$P(PXNODE,U,2)
. S PXTO=$P(PXNODE,U,4)
. I PXFROM="IMM" S PXFROMEN=$P($G(^AUTTIMM(PXFROMEN,0)),U,1)
. I PXFROM="CPT" S PXFROMEN=$$CODEC^ICPTCOD(PXFROMEN)
. I (PXFROMEN="")!(PXFROMEN=-1) Q
. I PXTO="IMM" S PXTOEN=$P($G(^AUTTIMM(PXTOEN,0)),U,1)
. I PXTO="CPT" S PXTOEN=$$CODEC^ICPTCOD(PXTOEN)
. S ^TMP("PX215PCM",$J,$$LINE())=PXINSTNUM_U_PXINSTNAME_U_PXFROM_U_PXFROMEN_U_PXTO_U_PXTOEN
;
I '$D(^TMP("PX215PCM",$J)) D Q
. D MES("No entries to report.")
;
S ^TMP("PX215PCM",$J,1)="This report was generated by the PX*1*215 Post-Install. It contains a list of"
S ^TMP("PX215PCM",$J,3)="entries from the PCE CODE MAPPING file (#811.1) for your review."
S ^TMP("PX215PCM",$J,4)=" "
S ^TMP("PX215PCM",$J,5)="This report lists entries where both: "
S ^TMP("PX215PCM",$J,6)=" 1. The FROM field (#.03) equals ""CPT"" OR the immunization in the File Entry"
S ^TMP("PX215PCM",$J,7)=" field (#.01) is inactive."
S ^TMP("PX215PCM",$J,8)=" 2. And the ON/OFF FLAG field (#.05) equals ""ON""."
S ^TMP("PX215PCM",$J,9)=" "
S ^TMP("PX215PCM",$J,10)="Station #^Station Name^From^From Code^To^To Code"
;
S PXMSGSUB=PXINSTNUM_" PCE CODE MAPPING DATA FOR REVIEW"
S PXMSGTO(DUZ)=""
S PXREMMGIEN=$$GET1^DIQ(800,1_",",3)
I PXREMMGIEN'="" D
. S PXMGROUP="G."_$$GET1^DIQ(3.8,PXREMMGIEN_",",.01)
. S PXMSGTO(PXMGROUP)=""
I $$PROD^XUPROD(),$G(DUZ("AG"))="V" D
. S PXMSGTO("TEITELBAUM.LEVI@DOMAIN.EXT")=""
. S PXMSGTO("SILVERMAN.ROBERT@DOMAIN.EXT")=""
. S PXMSGTO("BRYAN.VOLPP@DOMAIN.EXT")=""
S PXINSTR("FROM")="PX*1*215 POST-INSTALL"
S PXINSTR("ADDR FLAGS")="R"
D SENDMSG^XMXAPI(DUZ,PXMSGSUB,"^TMP(""PX215PCM"",$J)",.PXMSGTO,.PXINSTR,.PXMSGNUM)
D MES("Emailed report message (#"_$G(PXMSGNUM)_")")
I $G(XMERR),$D(^TMP("XMERR",$J)) D
. D MES("The following errors occurred while sending the email:")
. S PXERRNUM=0
. F S PXERRNUM=$O(^TMP("XMERR",$J,PXERRNUM)) Q:'PXERRNUM D
. . S PXERRTXT=" "_PXERRNUM_". "
. . S PXERRLN=0
. . F S PXERRLN=$O(^TMP("XMERR",$J,PXERRNUM,"TEXT",PXERRLN)) Q:'PXERRLN D
. . . S PXERRTXT=PXERRTXT_$G(^TMP("XMERR",$J,PXERRNUM,"TEXT",PXERRLN))
. . . D MES(PXERRTXT)
. . . S PXERRTXT=" "
;
K ^TMP("PX215PCM",$J)
;
Q
;
LINE() ;
S PXLINE=PXLINE+1
Q PXLINE
;-------------------------------------------------------------------------
;
LOAD9206 ; Populate data for #920.6
;
N PXERRMSG,PXFDA,PXI,PXIENS,PXROUTE,PXROUTENM,PXROUTES,PXSITE,PXSITEHL,PXSITES
;
D BMES("*** Populating data for #920.6 ***")
;
I $O(^PXV(920.6,0)) D Q
. D MES("Data already populated... no need to populate again.")
;
S PXROUTES("INTRADERMAL")="LA^LLFA^LT^RA^RLFA^RT"
S PXROUTES("PERCUTANEOUS")="LA^LLFA^LT^RA^RLFA^RT"
S PXROUTES("SUBCUTANEOUS")="LA^LLFA^LT^RA^RLFA^RT"
S PXROUTES("INTRAMUSCULAR")="LD^LG^LVL^RD^RG^RVL^RVG^LVG"
S PXROUTES("NASAL")="BN^LN^RN"
S PXROUTES("ORAL")=""
;
S PXROUTENM=""
F S PXROUTENM=$O(PXROUTES(PXROUTENM)) Q:PXROUTENM="" D
. K PXFDA,PXERRMSG,PXIENS
. D CLEAN^DILF
. ;
. S PXROUTE=$O(^PXV(920.2,"B",PXROUTENM,0))
. I 'PXROUTE D Q
. . D MES("Can't add mappings for route '"_PXROUTENM_"', as no #920.2 entry was found for it.")
. ;
. S PXFDA(1,920.6,"?+1,",.01)=PXROUTE
. S PXIENS(1)=PXROUTE
. ;
. S PXSITES=$G(PXROUTES(PXROUTENM))
. F PXI=1:1 S PXSITEHL=$P(PXSITES,U,PXI) Q:PXSITEHL="" D
. . S PXSITE=$O(^PXV(920.3,"B",PXSITEHL,0))
. . I 'PXSITE D Q
. . . D MES("Can't add site '"_PXSITEHL_"', as no #920.3 entry was found for it.")
. . ;
. . S PXFDA(1,920.61,"?+"_(PXI+1)_",?+1,",.01)=PXSITE
. ;
. D UPDATE^DIE("","PXFDA(1)","PXIENS")
. I $D(^TMP("DIERR",$J)) D
. . D MES("The following errors occurred:")
. . D MSG^DIALOG("AE",.PXERRMSG)
. . D MES^XPDUTL(.PXERRMSG)
. ;
. K PXFDA,PXERRMSG,PXIENS
. D CLEAN^DILF
;
Q
;
;-------------------------------------------------------------------------
;
BMES(STR) ;
; Write string
D BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
Q
MES(STR) ;
; Write string
D MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVP215 5544 printed Dec 13, 2024@02:31:51 Page 2
PXVP215 ;BPFO/LMT - PX*1*215 KIDS Routine ;04/05/2016
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
+2 ;
POST ; KIDS Post install for PX*1*215
+1 DO BMES("*** Post install started ***")
+2 ;
+3 ; Delete Coding System multiple from file #9000010.12
SET DIU=9000010.123
SET DIU(0)="S"
DO EN^DIU2
KILL DIU
+4 ; Generate PCE Code Mapping Report
DO CODEMAP
+5 ; Populate data for #920.6
DO LOAD9206
+6 ;
+7 DO BMES("*** Post install completed ***")
+8 QUIT
+9 ;
+10 ;---------------------------------------------------------------------
CODEMAP ; Generate PCE Code Mapping Report
+1 ;
+2 NEW PXERRLN,PXERRNUM,PXERRTXT,PXFROM,PXFROMEN,PXIEN,PXIMM,PXINCLUDE,PXINST,PXINSTNAME,PXINSTNUM
+3 NEW PXINSTR,PXLINE,PXMGROUP,PXMSGSUB,PXMSGTO,PXNODE,PXREMMGIEN,PXTO,PXTOEN,XMERR
+4 ;
+5 DO BMES("*** Generating PCE CODE MAPPING Report ***")
+6 ;
+7 KILL ^TMP("PX215PCM",$JOB)
+8 ;
+9 SET PXINST=$$KSP^XUPARAM("INST")
+10 SET PXINSTNAME=$$NAME^XUAF4(PXINST)
+11 SET PXINSTNUM=$$STA^XUAF4(PXINST)
+12 ;
+13 ; Start at #10, as the preamble part of the message will be in lines 1-10
SET PXLINE=10
+14 ;
+15 SET PXIEN=0
+16 FOR
SET PXIEN=$ORDER(^PXD(811.1,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+17 SET PXNODE=$GET(^PXD(811.1,PXIEN,0))
+18 ;
+19 IF '$PIECE(PXNODE,U,5)
QUIT
+20 ;
+21 SET PXFROM=$PIECE(PXNODE,U,3)
+22 SET PXINCLUDE=0
+23 IF PXFROM="CPT"
SET PXINCLUDE=1
+24 IF PXFROM="IMM"
Begin DoDot:2
+25 SET PXIMM=+$PIECE(PXNODE,U,1)
+26 IF $$IMMSTAT^PXAPIIM(PXIMM)'="A"
SET PXINCLUDE=1
End DoDot:2
+27 ;
+28 IF 'PXINCLUDE
QUIT
+29 ;
+30 SET PXFROMEN=+$PIECE(PXNODE,U,1)
+31 SET PXTOEN=+$PIECE(PXNODE,U,2)
+32 SET PXTO=$PIECE(PXNODE,U,4)
+33 IF PXFROM="IMM"
SET PXFROMEN=$PIECE($GET(^AUTTIMM(PXFROMEN,0)),U,1)
+34 IF PXFROM="CPT"
SET PXFROMEN=$$CODEC^ICPTCOD(PXFROMEN)
+35 IF (PXFROMEN="")!(PXFROMEN=-1)
QUIT
+36 IF PXTO="IMM"
SET PXTOEN=$PIECE($GET(^AUTTIMM(PXTOEN,0)),U,1)
+37 IF PXTO="CPT"
SET PXTOEN=$$CODEC^ICPTCOD(PXTOEN)
+38 SET ^TMP("PX215PCM",$JOB,$$LINE())=PXINSTNUM_U_PXINSTNAME_U_PXFROM_U_PXFROMEN_U_PXTO_U_PXTOEN
End DoDot:1
+39 ;
+40 IF '$DATA(^TMP("PX215PCM",$JOB))
Begin DoDot:1
+41 DO MES("No entries to report.")
End DoDot:1
QUIT
+42 ;
+43 SET ^TMP("PX215PCM",$JOB,1)="This report was generated by the PX*1*215 Post-Install. It contains a list of"
+44 SET ^TMP("PX215PCM",$JOB,3)="entries from the PCE CODE MAPPING file (#811.1) for your review."
+45 SET ^TMP("PX215PCM",$JOB,4)=" "
+46 SET ^TMP("PX215PCM",$JOB,5)="This report lists entries where both: "
+47 SET ^TMP("PX215PCM",$JOB,6)=" 1. The FROM field (#.03) equals ""CPT"" OR the immunization in the File Entry"
+48 SET ^TMP("PX215PCM",$JOB,7)=" field (#.01) is inactive."
+49 SET ^TMP("PX215PCM",$JOB,8)=" 2. And the ON/OFF FLAG field (#.05) equals ""ON""."
+50 SET ^TMP("PX215PCM",$JOB,9)=" "
+51 SET ^TMP("PX215PCM",$JOB,10)="Station #^Station Name^From^From Code^To^To Code"
+52 ;
+53 SET PXMSGSUB=PXINSTNUM_" PCE CODE MAPPING DATA FOR REVIEW"
+54 SET PXMSGTO(DUZ)=""
+55 SET PXREMMGIEN=$$GET1^DIQ(800,1_",",3)
+56 IF PXREMMGIEN'=""
Begin DoDot:1
+57 SET PXMGROUP="G."_$$GET1^DIQ(3.8,PXREMMGIEN_",",.01)
+58 SET PXMSGTO(PXMGROUP)=""
End DoDot:1
+59 IF $$PROD^XUPROD()
IF $GET(DUZ("AG"))="V"
Begin DoDot:1
+60 SET PXMSGTO("TEITELBAUM.LEVI@DOMAIN.EXT")=""
+61 SET PXMSGTO("SILVERMAN.ROBERT@DOMAIN.EXT")=""
+62 SET PXMSGTO("BRYAN.VOLPP@DOMAIN.EXT")=""
End DoDot:1
+63 SET PXINSTR("FROM")="PX*1*215 POST-INSTALL"
+64 SET PXINSTR("ADDR FLAGS")="R"
+65 DO SENDMSG^XMXAPI(DUZ,PXMSGSUB,"^TMP(""PX215PCM"",$J)",.PXMSGTO,.PXINSTR,.PXMSGNUM)
+66 DO MES("Emailed report message (#"_$GET(PXMSGNUM)_")")
+67 IF $GET(XMERR)
IF $DATA(^TMP("XMERR",$JOB))
Begin DoDot:1
+68 DO MES("The following errors occurred while sending the email:")
+69 SET PXERRNUM=0
+70 FOR
SET PXERRNUM=$ORDER(^TMP("XMERR",$JOB,PXERRNUM))
if 'PXERRNUM
QUIT
Begin DoDot:2
+71 SET PXERRTXT=" "_PXERRNUM_". "
+72 SET PXERRLN=0
+73 FOR
SET PXERRLN=$ORDER(^TMP("XMERR",$JOB,PXERRNUM,"TEXT",PXERRLN))
if 'PXERRLN
QUIT
Begin DoDot:3
+74 SET PXERRTXT=PXERRTXT_$GET(^TMP("XMERR",$JOB,PXERRNUM,"TEXT",PXERRLN))
+75 DO MES(PXERRTXT)
+76 SET PXERRTXT=" "
End DoDot:3
End DoDot:2
End DoDot:1
+77 ;
+78 KILL ^TMP("PX215PCM",$JOB)
+79 ;
+80 QUIT
+81 ;
LINE() ;
+1 SET PXLINE=PXLINE+1
+2 QUIT PXLINE
+3 ;-------------------------------------------------------------------------
+4 ;
LOAD9206 ; Populate data for #920.6
+1 ;
+2 NEW PXERRMSG,PXFDA,PXI,PXIENS,PXROUTE,PXROUTENM,PXROUTES,PXSITE,PXSITEHL,PXSITES
+3 ;
+4 DO BMES("*** Populating data for #920.6 ***")
+5 ;
+6 IF $ORDER(^PXV(920.6,0))
Begin DoDot:1
+7 DO MES("Data already populated... no need to populate again.")
End DoDot:1
QUIT
+8 ;
+9 SET PXROUTES("INTRADERMAL")="LA^LLFA^LT^RA^RLFA^RT"
+10 SET PXROUTES("PERCUTANEOUS")="LA^LLFA^LT^RA^RLFA^RT"
+11 SET PXROUTES("SUBCUTANEOUS")="LA^LLFA^LT^RA^RLFA^RT"
+12 SET PXROUTES("INTRAMUSCULAR")="LD^LG^LVL^RD^RG^RVL^RVG^LVG"
+13 SET PXROUTES("NASAL")="BN^LN^RN"
+14 SET PXROUTES("ORAL")=""
+15 ;
+16 SET PXROUTENM=""
+17 FOR
SET PXROUTENM=$ORDER(PXROUTES(PXROUTENM))
if PXROUTENM=""
QUIT
Begin DoDot:1
+18 KILL PXFDA,PXERRMSG,PXIENS
+19 DO CLEAN^DILF
+20 ;
+21 SET PXROUTE=$ORDER(^PXV(920.2,"B",PXROUTENM,0))
+22 IF 'PXROUTE
Begin DoDot:2
+23 DO MES("Can't add mappings for route '"_PXROUTENM_"', as no #920.2 entry was found for it.")
End DoDot:2
QUIT
+24 ;
+25 SET PXFDA(1,920.6,"?+1,",.01)=PXROUTE
+26 SET PXIENS(1)=PXROUTE
+27 ;
+28 SET PXSITES=$GET(PXROUTES(PXROUTENM))
+29 FOR PXI=1:1
SET PXSITEHL=$PIECE(PXSITES,U,PXI)
if PXSITEHL=""
QUIT
Begin DoDot:2
+30 SET PXSITE=$ORDER(^PXV(920.3,"B",PXSITEHL,0))
+31 IF 'PXSITE
Begin DoDot:3
+32 DO MES("Can't add site '"_PXSITEHL_"', as no #920.3 entry was found for it.")
End DoDot:3
QUIT
+33 ;
+34 SET PXFDA(1,920.61,"?+"_(PXI+1)_",?+1,",.01)=PXSITE
End DoDot:2
+35 ;
+36 DO UPDATE^DIE("","PXFDA(1)","PXIENS")
+37 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:2
+38 DO MES("The following errors occurred:")
+39 DO MSG^DIALOG("AE",.PXERRMSG)
+40 DO MES^XPDUTL(.PXERRMSG)
End DoDot:2
+41 ;
+42 KILL PXFDA,PXERRMSG,PXIENS
+43 DO CLEAN^DILF
End DoDot:1
+44 ;
+45 QUIT
+46 ;
+47 ;-------------------------------------------------------------------------
+48 ;
BMES(STR) ;
+1 ; Write string
+2 DO BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," "))
+3 QUIT
MES(STR) ;
+1 ; Write string
+2 DO MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," "))
+3 QUIT
