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

BCSVMR2.m

Go to the documentation of this file. 
  1. BCSVMR2 ;IHS/MSC/PLS - CSV Mapping Report;28-Jul-2008 12:55;AA
  1.  ;;1.0;BCSV;;APR 23, 2010
  1.  ;=================================================================
  1.  Q
  1. EN ; EP - Generate mapping status report.
  1.  N POP,UNMAPF,MAPF
  1.  W !,"Mapping Report for Code Set Versioning Project - Phase One",!!
  1.  D ENVCHK
  1.  D PARAM
  1.  D DEVICE
  1.  Q:POP
  1.  D TASK
  1.  Q
  1.  ;
  1. TASK ;EP
  1.  N ZTRTN,ZTDTH,ZTDESC
  1.  S ZTRTN="OUTPUT^BCSVMR2"
  1.  I $G(IO("Q")) D
  1.  .S ZTDTH=$H
  1.  .S ZTDESC="CSV Field Mapping Report"
  1.  .S ZTIO=ION
  1.  .S ZTSAVE("UNMAPF")="",ZTSAVE("MAPF")=""
  1.  .D ^%ZTLOAD
  1.  E  D @ZTRTN
  1.  D ^%ZISC
  1.  Q
  1.  ; Generate report
  1. OUTPUT ;
  1.  N SIZE,FLAGQ,FLAGP,FLAGE,FIL,LP,DLM,DDLM,EFLG,OFF,SRC,TRG
  1.  N DASH,DOT,EQUAL,RPTDATE,Z1,ARW
  1.  S SIZE=IOSL-5,FLAGP=1,ARW="=>"
  1.  D INIT^BCSVMP
  1.  S $P(DASH,"-",212)=""
  1.  S $P(DOT,".",106)=""
  1.  S $P(EQUAL,"=",212)=""
  1.  F  D  Q:$G(EFLG)!$G(FLAGE)
  1.  .S FIL=$$NXTFIL^BCSVMP(.OFF)
  1.  .I $P(FIL,DDLM,2)="" S EFLG=1 Q
  1.  .S FLAGQ=0
  1.  .D SETFILE^BCSVMP($P(FIL,DDLM,2),.SRC,.TRG)
  1.  .D PT(SRC("NUM"),SRC("FNAM"))
  1.  .S HD="" D PAGE
  1.  Q
  1.  ; Returns status of environment
  1. ENVCHK Q
  1.  ; Collects parameters
  1. PARAM ;
  1.  S UNMAPF=1,MAPF=1
  1.  W !,"WARNING:  Printing mapped items will consume a lot of paper",!
  1.  S UNMAPF=$$YN^BCSVMP("N","Include list of unmapped items")
  1.  S MAPF=$$YN^BCSVMP("N","Include list of mapped items")
  1.  I MAPF=1 D
  1.  .K RPTTYP
  1.  .N DIR,Y
  1.  .S DIR(0)="S^A:AUTOMAPPED;M:MANUALLY MAPPED;B:BOTH"
  1.  .S DIR("B")="B"
  1.  .S DIR("A")="What do you want to include"
  1.  .D ^DIR
  1.  .S RPTTYP=Y
  1.  W !
  1.  Q
  1.  ; Prompts for output device
  1. DEVICE ;
  1.  N %ZIS
  1.  S %ZIS="Q",%ZIS("A")="Select device for mapping report: "
  1.  D ^%ZIS
  1.  Q
  1.  ; Pointers to the file
  1. PT(FNUM,FNAM) ;EP
  1.  N FILE,FLD,ZGL,ZCNT,FILEN,ZFILE,ZGLCNT	
  1.  S ZGL=^DIC(FNUM,0,"GL")
  1.  ;S ZGLCNT=$G(@(ZGL_"0)")),ZGLCNT=$S($P(ZGLCNT,U,4)]"":$P(ZGLCNT,U,4),1:"No Entries")
  1.  S ZGLCNT=$$GLOBCNT(ZGL) I 'ZGLCNT S ZGLCNT="No Entries"
  1.  D INIT7 G:FLAGQ EX D HDRP S FILE="",ZCNT=1,HD="HDRP"
  1.  I '$D(^DD(FNUM,0,"PT")) W ?30,"No files point to the "_FNAM_" file." Q
  1.  F  S FILE=$O(^DD(FNUM,0,"PT",FILE)) Q:FILE=""!FLAGQ  D
  1.  .S FLAGPT=0 D @$S($D(^DIC(FILE,0)):"PTYES",1:"PTNO")
  1.  .I 'FLAGPT S FLD="" F  S FLD=$O(^DD(FNUM,0,"PT",FILE,FLD)) Q:FLD=""  D  Q:FLAGQ!$G(FLAGE)
  1.  ..D PTPRT Q:FLAGQ
  1.  S HD="" D PAGE
  1.  I '$G(FLAGE)&'FLAGQ D
  1.  .D:UNMAPF UNMAP(SRC("GNAM"))
  1.  .Q:$G(FLAGE)!FLAGQ
  1.  .D PAUSE
  1.  .Q:$G(FLAGE)!FLAGQ
  1.  .D:MAPF MAP(SRC("GNAM"))
  1.  K FLAGPT
  1.  Q
  1.  ; Get true global entry count
  1. GLOBCNT(GBL) ;
  1.  N LOOP,IEN,GCNT
  1.  S GCNT=0
  1.  S LOOP=GBL_"IEN)"
  1.  S IEN=0 F  S IEN=$O(@LOOP) Q:'IEN  D
  1.  .S GCNT=GCNT+1
  1.  Q GCNT
  1. PTNO ;
  1.  I '$D(^DD(FILE,0,"UP")) S FLAGPT=1 Q
  1.  S FILETP=FILE F  S FILETP=^DD(FILETP,0,"UP") Q:$D(^DIC(FILETP,0))  I '$D(^DD(FILETP,0,"UP")) Q
  1.  I '$D(^DIC(FILETP,0)) S FLAGPT=1 Q
  1.  S GL=^DIC(FILETP,0,"GL"),FILEN=$P(^DIC(FILETP,0),U)
  1.  Q
  1. PTYES S GL=^DIC(FILE,0,"GL"),FILEN=$P(^DIC(FILE,0),U)
  1.  Q
  1. PTPRT ;
  1.  N KNWPTR
  1.  S KNWPTR=$S($$KNWNPTR^BCSVMP(TRG("GNAM"),FILE,FLD):" ",1:"#")
  1.  W !,$J(ZCNT,4),".",?6,GL,?21,$E(FILEN,1,25)
  1.  W ?47 I $D(^DD(FILE,FLD,0)),$P(^(0),U)]"" W KNWPTR_$E($P(^(0),U),1,22)," (",FLD,")"
  1.  E  W "--> Field ",FLD," does not exist."
  1.  S ZCNT=ZCNT+1 I $Y>SIZE D PAGE
  1.  Q
  1.  ; Output unmapped items
  1. UNMAP(FIL) ;
  1.  N SIEN,GLBP,SOURCE,I
  1.  D HDRU S HD="HDRU"
  1.  S GLBP=$S(FIL="AUTTCMOD":$$GLBPATH^BCSVMP(TRG("GNAM"),"UNMAP"),1:$$GLBPATH^BCSVMP(SRC("GNAM"),"UNMAP"))
  1.  I '$$MAPCNT^BCSVMP($S(FIL="AUTTCMOD":TRG("GNAM"),1:SRC("GNAM")),"UNMAP") W !,"There are no unmapped entries." Q
  1.  S SIEN=0 F  S SIEN=$O(@GLBP@(SIEN)) Q:'SIEN  D  Q:FLAGQ
  1.  .Q:$$PSTCSVCD(SIEN)=1  ;IHS/SD/SDR 4/14/09
  1.  .S SDESC=$$GDESC^BCSVMP("S",SRC("NUM"),+SIEN,SRC("DFLD"),1)
  1.  .D BLDARY("SOURCE",SDESC)
  1.  .W !,?2,"*"
  1.  .S I=0 F  S I=$O(SOURCE(I)) Q:'I  D
  1.  ..W ?4,$G(SOURCE(I)) I $O(SOURCE(I)) W !
  1.  .D INAFLAG(SIEN)
  1.  .I $Y>SIZE D PAGE Q:FLAGQ
  1.  .W !
  1.  Q
  1.  ;start new code IHS/SD/SDR 4/14/09
  1.  ;check if code was added after 10/1/08; if so, skip it
  1. PSTCSVCD(SIEN) ;
  1.  ;CPT
  1.  S BCSVF=0
  1.  I SRC("NUM")=81 D
  1.  .I $$VERSION^XPDUTL("BCSV")>0 D
  1.  ..I $P($G(^ICPT(SIEN,9999999)),U,6)>3080930 S BCSVF=1
  1.  .I +$$VERSION^XPDUTL("BCSV")=0 D
  1.  ..I $P($G(^ICPT(SIEN,0)),U,6)>3080930 S BCSVF=1
  1.  ;ICD0
  1.  I SRC("NUM")=80.1 D
  1.  .I $P($G(^ICD0(SIEN,9999999)),U,4)>3080930 S BCSVF=1
  1.  ;ICD9
  1.  I SRC("NUM")=80 D
  1.  .I $P($G(^ICD9(SIEN,9999999)),U,4)>3080930 S BCSVF=1
  1.  Q BCSVF
  1.  ;end new code 4/14/09
  1.  ;start new code 6/25/09
  1. INAFLAG(SIEN) ;
  1.  ;CPT
  1.  I +$G(SIEN)=0 Q
  1.  S SIFLG=0
  1.  I SRC("NUM")=81 D
  1.  .S SIFLG=$$GET1^DIQ(81,SIEN,7,"I")
  1.  ;ICD0
  1.  I SRC("NUM")=80.1 D
  1.  .S SIFLG=$$GET1^DIQ(80.1,SIEN,102,"I")
  1.  ;ICD9
  1.  I SRC("NUM")=80 D
  1.  .S SIFLG=$$GET1^DIQ(80,SIEN,102,"I")
  1.  ;
  1.  I SIFLG W " (INACTIVE)"
  1.  Q
  1.  ;end new code 6/25/09
  1.  ; Output mapped items  IHS === VA
  1. MAP(FIL) ;
  1.  N SIEN,TIEN,GLBP,SOURCE,TARGET,I
  1.  D HDRM S HD="HDRM"
  1.  ;S GLBP=$$GLBPATH^BCSVMP(SRC("GNAM"),"MAP")
  1.  S GLBP=$S(FIL="AUTTCMOD":$$GLBPATH^BCSVMP(TRG("GNAM"),"MAP"),1:$$GLBPATH^BCSVMP(SRC("GNAM"),"MAP"))
  1.  ;I '$$MAPCNT^BCSVMP(SRC("GNAM"),"MAP")	W !,"There are no mapped entries." Q
  1.  I '$$MAPCNT^BCSVMP($S(FIL="AUTTCMOD":TRG("GNAM"),1:SRC("GNAM")),"MAP") W !,"There are no mapped entries." Q
  1.  S SIEN=0 F  S SIEN=$O(@GLBP@(SIEN)) Q:'SIEN  D  Q:FLAGQ
  1.  .I ($G(RPTTYP)="A"!($G(RPTTYP)="M"))&($P($G(@GLBP@(SIEN)),U,2)'=RPTTYP) Q  ;only do auto/manually mapped
  1.  .S SDESC=$$GDESC^BCSVMP("S",SRC("NUM"),+SIEN,SRC("DFLD"),1)
  1.  .S TDESC=$$GDESC^BCSVMP("T",$$GLBPATH^BCSVMP(TRG("GNAM"),"DATA"),+@$$GLBPATH^BCSVMP(TRG("GNAM"),"MAP")@(+SIEN),TRG("DFLD"),1)
  1.  .;I $L(SDESC)>30 D
  1.  .;.W !,?2,SDESC,?35,ARW
  1.  .;.I $Y>SIZE D PAGE Q:FLAGQ
  1.  .;.W !,?10,TDESC
  1.  .;E  W !,?2,SDESC,?46,TDESC
  1.  .D BLDARY("SOURCE",SDESC)
  1.  .W !,?1,"*"
  1.  .S I=0 F  S I=$O(SOURCE(I)) Q:'I  D
  1.  ..W ?4,$G(SOURCE(I)) I $O(SOURCE(I)) W !
  1.  .W " ("_$P($G(@GLBP@(SIEN)),U,2)_")"
  1.  .D BLDARY("TARGET",TDESC)
  1.  .W !,ARW
  1.  .S I=0 F  S I=$O(TARGET(I)) Q:'I  D
  1.  ..W ?4,$G(TARGET(I)) I $O(SOURCE(I)) W !
  1.  .I $Y>SIZE D PAGE Q:FLAGQ
  1.  .W !
  1.  Q
  1.  ; Input  ARY - name of array where to store data
  1.  ;        DESC - description as gathered from $$GDESC^BCSVMP
  1. BLDARY(ARY,DESC) ;
  1.  N WORD,STRING,I,LINE,NDESC
  1.  K @ARY
  1.  S STRING="",LINE=1
  1.  I $L(DESC)<70 S @ARY@(LINE)=DESC Q
  1.  S NDESC=$P(DESC,"  ")_" // "_$P(DESC,"  ",2),DESC=NDESC
  1.  F I=1:1  D  Q:'$L(WORD)
  1.  .S WORD=$P(DESC," ",I)
  1.  .I '$L(WORD),$L(STRING)>0 S @ARY@(LINE)=$G(STRING) Q
  1.  .Q:WORD="//"
  1.  .I ($L(STRING)+$L(WORD)+1<70)!($L(STRING)+$L(WORD)+1=70) D  Q
  1.  ..S STRING=$G(STRING)_$S($L(STRING)=0:"",1:" ")_WORD
  1.  .E  D
  1.  ..S @ARY@(LINE)=$G(STRING),LINE=LINE+1,STRING=""
  1.  .I ($L(WORD)<70)!($L(WORD)=70) S STRING=WORD Q
  1.  .E  D
  1.  ..S @ARY@(LINE)=$E(WORD,1,70),LINE=LINE+1
  1.  ..S @ARY@(LINE)=$E(WORD,71,140),LINE=LINE+1
  1.  ;I DESC["NON-INVASIVE PERIPHERAL VASCULAR DIAGNOSTIC STUDIES" S A=B
  1.  Q
  1. HDR ;
  1.  W @IOF Q:'FLAGP  W:IO'=IO(0) !!
  1.  I '$D(RPTDATE) S RPTDATE=$$FMTE^XLFDT($$DT^XLFDT(),"2Z")
  1.  W !,$E(EQUAL,1,IOM)
  1.  W !?2,"File:---- ",FNAM," (",FNUM,")"
  1.  W !?2,"Global:-- ",ZGL,?(IOM-17),"Date: ",RPTDATE
  1.  W !?2,"Total Entries: ",ZGLCNT,?30,"Mapped: ",$$MAPCNT^BCSVMP(TRG("GNAM"),"MAP"),?50,"Unmapped: ",$$MAPCNT^BCSVMP(TRG("GNAM"),"UNMAP")
  1.  W !,$E(EQUAL,1,IOM),!
  1.  Q
  1. HDRP ;
  1.  W !?3,"Pointers TO the "_FNAM_" ("_FNUM_") file.."
  1.  W !?5,"A # indicates that the field is a LOCAL pointer."
  1.  W !?9,"GLOBAL",?22,"FILE  (Truncated to 25)",?50,"FIELD   (Truncated to 22)"
  1.  W !?6,"-------------",?21,"-------------------------",?48,"------------------------------"
  1.  Q
  1. HDRU ; Unmapped items header
  1.  W @IOF Q:'FLAGP  W:IO'=IO(0) !!
  1.  W !,$E(EQUAL,1,IOM)
  1.  W !,"The following entries have not been mapped to the VA codes."
  1.  W !,"  IHS Value"
  1.  W !,$E(EQUAL,1,IOM),!
  1.  Q
  1. HDRM ; Mapped Items header
  1.  W @IOF Q:'FLAGP  W:IO'=IO(0) !!
  1.  W !,$E(EQUAL,1,IOM)	
  1.  W !,"The following items are mapped."
  1.  W !," * IHS Value"
  1.  W !," => VA Value"
  1.  W !,$E(EQUAL,1,IOM),!
  1.  Q
  1. PAGE ;
  1.  Q:FLAGQ
  1.  N I F I=$Y:1:SIZE W !
  1.  I FLAGP,IO'=IO(0)!($D(ZTQUEUED)) W @IOF,!!! D:HD'="" @HD Q
  1.  R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME
  1.  S:'$T Z1=U
  1.  I Z1[U S FLAGQ=1 S:Z1="^^" FLAGE=1
  1.  W:'$G(FLAGE) @IOF
  1.  Q:FLAGQ!($D(FLAGE))
  1.  D:$L(HD) @HD
  1.  Q
  1. PAUSE ;
  1.  ;
  1.  Q
  1. INIT7 ;
  1.  ;I FLAGP,IO=IO(0),IOSL>25,IOST["C-" D SCROLL Q:FLAGQ
  1.  I FLAGP U IO ;W:IO'=IO(0) "Printing.."
  1.  D HDR Q
  1. EX ;	
  1.  K FLAGPT,^UTILITY($J,"GROUP")
  1.  Q
  1. SCROLL ;Adjust scroll rate
  1.  W !!?8,"SCROLLING:  [N]ormal  [S]mooth . . . . ","Select: N//"
  1.  R SCROLL:DTIME S:'$T SCROLL="^" S SCROLL=$E(SCROLL) I SCROLL="^" S FLAGQ=1 Q
  1.  I SCROLL="?" W !?8,"Since you're printing to your CRT and you've asked for a page",!?8,"length greater than 25, you may now adjust the scroll rate.",!?8,"For DEC VT-100 compatible devices only." G SCROLL
  1.  S:SCROLL="" SCROLL="N" Q:"S,s"'[SCROLL  S FLAGS=1 W *27,"[?4h"
  1.  Q