107 lines
3.9 KiB
Mathematica
107 lines
3.9 KiB
Mathematica
MCPOS04 ;HIRMFO/DAD-CONSULT CONVERSION 699 >>>===> 699.5 ;7/5/96 10:33
|
|
;;2.3;Medicine;;09/13/1996
|
|
;
|
|
S MCONSULT=+$O(^MCAR(697.2,"B","CONSULT",0))
|
|
S MCFOUND=$S($P($G(^MCAR(697.2,MCONSULT,0)),U)'="CONSULT":0,1:1)
|
|
;
|
|
I $D(XPDNM) D G:'MCFOUND EXIT
|
|
. K MCDATA
|
|
. S MCDATA(1)=""
|
|
. S MCDATA(2)="Moving the Consult data from the Endoscopy/Consult"
|
|
. S MCDATA(3)="file (#699) to the Generalized Procedure/Consult"
|
|
. S MCDATA(4)="file (#699.5)."
|
|
. ;
|
|
. I 'MCFOUND D
|
|
.. S MCDATA(5)=""
|
|
.. S MCDATA(6)="The CONSULT entry was not found in the"
|
|
.. S MCDATA(7)="PROCEDURE/SPECIALTY file (#697.2), data cannot"
|
|
.. S MCDATA(8)="be converted without this entry being present."
|
|
.. Q
|
|
. D MES^XPDUTL(.MCDATA) K MCDATA
|
|
. Q
|
|
E D G EXIT
|
|
. W !!,"Moving the Consult data from the Endoscopy/Consult"
|
|
. W !,"file (#699) to the Generalized Procedure/Consult"
|
|
. W !,"file (#699.5)."
|
|
. ;
|
|
. I 'MCFOUND D Q
|
|
.. W !!,"The CONSULT entry was not found in the"
|
|
.. W !,"PROCEDURE/SPECIALTY file (#697.2), data cannot"
|
|
.. W !,"be converted without this entry being present."
|
|
.. Q
|
|
. ;
|
|
. S ZTRTN="TASK^MCPOS04"
|
|
. S ZTDESC="Medicine Consult Conversion"
|
|
. S ZTSAVE("MCONSULT")=""
|
|
. S ZTIO=""
|
|
. W ! D ^%ZTLOAD
|
|
. W !!,"Conversion",$S($G(ZTSK)'>0:" not ",1:" "),"queued."
|
|
. I $G(ZTSK)>0 W !,"Task # ",ZTSK,"."
|
|
. Q
|
|
TASK ;
|
|
S MC699D0=0
|
|
F S MC699D0=$O(^MCAR(699,"D",MCONSULT,MC699D0)) Q:MC699D0'>0 D MAIN
|
|
EXIT ;
|
|
I '$D(XPDNM),$D(ZTQUEUED) S ZTREQ="@"
|
|
Q
|
|
MAIN ;
|
|
K MCDATA
|
|
F MCNODE=0,.2,15,"PCC","OR","ES","PROV" D
|
|
. S MCDATA(MCNODE)=$G(^MCAR(699,MC699D0,MCNODE))
|
|
. Q
|
|
I $P(MCDATA(0),U,12)'=MCONSULT Q
|
|
S MCDATE=$P(MCDATA(0),U),MCDFN=$P(MCDATA(0),U,2)
|
|
S MCPRC=$P(MCDATA(0),U,12)
|
|
S (MC6995D0,MCIEN)=0
|
|
F S MCIEN=$O(^MCAR(699.5,"B",MCDATE,MCIEN)) Q:MCIEN'>0!MC6995D0 D
|
|
. S MC=$G(^MCAR(699.5,MCIEN,0))
|
|
. S MCNEWDFN=$P(MC,U,2),MCNEWPRC=$P(MC,U,6)
|
|
. I MCNEWDFN=MCDFN,MCNEWPRC=MCPRC S MC6995D0=MCIEN
|
|
. Q
|
|
I MC6995D0'>0 D
|
|
. K DD,DIC,DINUM,DO
|
|
. S DIC="^MCAR(699.5,",DIC(0)="L",DLAYGO=699.5
|
|
. S DIC("DR")=".02///`"_MCDFN_";.05////"_MCPRC
|
|
. S X=MCDATE D FILE^DICN S MC6995D0=+Y
|
|
. Q
|
|
;
|
|
I MC6995D0'>0 Q
|
|
S MCINDCOM=$P(MCDATA(0),U,6),MCSUMMRY=$P(MCDATA(.2),U)
|
|
S MCPRCSUM=$P(MCDATA(.2),U,2),MCCONTYP=$P(MCDATA(15),U,11)
|
|
S MCPROVID=$P(MCDATA(0),U,8)
|
|
I MCPROVID'>0 S MCPROVID=$P(MCDATA("PROV"),U)
|
|
K DA,DIC,DIE,DR S MCDRNUM=1
|
|
S DR="2///1"
|
|
I MCINDCOM]"" S DR(1,699.5,MCDRNUM)="3///^S X=$E(MCINDCOM,1,110)",MCDRNUM=MCDRNUM+1
|
|
I $P($G(^VA(200,+MCPROVID,0)),U)]"",$D(^XUSEC("PROVIDER",+MCPROVID))#2 S DR(1,699.5,MCDRNUM)="6///`"_MCPROVID,MCDRNUM=MCDRNUM+1
|
|
I "^A^N^I^"[(U_MCSUMMRY_U) S DR(1,699.5,MCDRNUM)="601///"_MCSUMMRY,MCDRNUM=MCDRNUM+1
|
|
I MCPRCSUM]"" S DR(1,699.5,MCDRNUM)="600///^S X=$E(MCPRCSUM,1,79)",MCDRNUM=MCDRNUM+1
|
|
I $P($G(^MCAR(699.82,+MCCONTYP,0)),U)]"" S DR(1,699.5,MCDRNUM)="31.5///`"_MCCONTYP,MCDRNUM=MCDRNUM+1
|
|
I $P($G(^AUPNVSIT(+$P(MCDATA("PCC"),U),0)),U)]"" S DR(1,699.5,MCDRNUM)="900////"_+$P(MCDATA("PCC"),U),MCDRNUM=MCDRNUM+1
|
|
S ORIFN=+$P(MCDATA("OR"),U),GMRCO=+$P(MCDATA("OR"),U,2)
|
|
I $P($G(^OR(100,ORIFN,0)),U)]"" S DR(1,699.5,MCDRNUM)="1000////"_ORIFN,MCDRNUM=MCDRNUM+1
|
|
I $P($G(^GMR(123,GMRCO,0)),U)]"" S DR(1,699.5,MCDRNUM)="1001////"_GMRCO,MCDRNUM=MCDRNUM+1
|
|
F MCPIECE=1:1:16 D
|
|
. S MCDATA=$P(MCDATA("ES"),U,MCPIECE) Q:MCDATA=""
|
|
. S MCSLASH="///"
|
|
. I "^1^4^13^"[(U_MCPIECE_U) S MCSLASH=MCSLASH_"`" I $P($G(^VA(200,+MCDATA,0)),U)="" Q
|
|
. I "^2^5^"[(U_MCPIECE_U) D
|
|
.. S MCVALCOD(MCPIECE)=$E(MCDATA,1,40)
|
|
.. S MCSLASH=MCSLASH_"^S X="
|
|
.. S MCDATA="MCVALCOD("_MCPIECE_")"
|
|
.. Q
|
|
. I 7=MCPIECE I "^D^PD^RV^ROV^RNV^S^SRV^SROV^"'[(U_MCDATA_U) Q
|
|
. I 10=MCPIECE I MCDATA<0!(MCDATA>999999999) Q
|
|
. I 11=MCPIECE I MCDATA<0!(MCDATA>99999999999999) Q
|
|
. I 16=MCPIECE I MCDATA<0!(MCDATA>999) Q
|
|
. I 14=MCPIECE S X=MCDATA,%DT="TX" D ^%DT S MCDATA=Y
|
|
. I "^3^6^8^9^14^15^"[(U_MCPIECE_U) Q:MCDATA\1'?7N
|
|
. I 12=MCPIECE I MCDATA'=1 Q
|
|
. S DR(1,699.5,MCDRNUM)=(1499+MCPIECE)_MCSLASH_MCDATA
|
|
. S MCDRNUM=MCDRNUM+1
|
|
. Q
|
|
S DIE="^MCAR(699.5,",DA=MC6995D0 D ^DIE ; ALL FLAT FIELDS
|
|
;
|
|
D ^MCPOS04A ; MULTIPLES
|
|
Q
|