ECINCONV ;BIR/DMA,JPW-Convert Procedures ;7 May 96
;;2.0; EVENT CAPTURE ;;8 May 96
;
EN ;entry point
S XQABT4=$H
D MES^XPDUTL("Re-indexing the MEDICAL SPECIALTY file (#723)...")
K ^ECC(723,"B") K DIK S DIK="^ECC(723," D IXALL^DIK K DIK
K ^EC(725,"B") K DIK S DIK="^EC(725,",DIK(1)=".01^B" D ENALL^DIK K DIK
D MES^XPDUTL("Re-indexing completed.")
I $P($G(^EC(720.1,1,0)),"^",2) G MSG
I $D(^ECH(0)),'$O(^ECH(0)) G LOG
D MES^XPDUTL("Beginning conversion of procedures "_$$HTE^XLFDT($H))
I '$D(DT) S DT=$$DT^XLFDT
S ECNEW=89999,EC=0 F S EC=$O(^ECP(EC)) Q:'EC I $D(^(EC,0)) S EC1=^(0),ECN=$P(EC1,"^",2) D
.I ECN="" D MES^XPDUTL("Procedure "_$P(EC1,U)_" was not converted") Q
.I $P(EC1,"^",3) S ^EC(726,EC,0)=$P(EC1,"^")_"^"_DT,^EC(726,"B",$P(EC1,"^"),EC)="",X=$P(^EC(726,0),"^",4)+1,$P(^(0),"^",3,4)=EC_"^"_X
.;create category if appropriate
.S ECPT=$O(^ICPT("B",ECN,0)) I ECPT S ^ECP(EC,"V")=ECPT_";ICPT(" Q
.S ECP=$O(^EC(725,"E",ECN,0)) I ECP S ^ECP(EC,"V")=ECP_";EC(725," Q
.I $O(^EC(725,$E(EC1,1,50),0)) Q
.I ECN'?1U4AN D MES^XPDUTL("Procedure "_$P(EC1,U)_" was not converted") Q
.F S ECNEW=ECNEW+1 Q:'$D(^EC(725,ECNEW,0))
.S ^EC(725,ECNEW,0)=$P(EC1,"^",1,2),^ECP(EC,"V")=ECNEW_";EC(725,",DA=ECNEW,DIK="^EC(725," D IX^DIK S X=$P(^EC(725,0),"^",4)+1,$P(^(0),"^",3,4)=ECNEW_"^"_X
;
;Now the event code screens
D MES^XPDUTL("Beginning the conversion of Event Code Screens "_$$HTE^XLFDT($H))
CODES ;
S EC=0 F S EC=$O(^ECK(EC)) Q:'EC S X=^(EC,0),Y1=+$P(X,"-",4),(ECOK,Y)=$G(^ECP(Y1,"V")) I $P($P(X,"^"),"-",4)'[";" D
.I Y="" S ECDP(1)="Event Code Screen "_$P(X,U)_" was not converted",ECDP(2)="It has been inactivated" S:$P(X,"^",2)="" $P(X,"^",2)=DT D
..S ^ECK(EC,0)=X,ECDP(3)="Procedure "_$S($D(^ECP(Y1,0)):$P(^(0),U)_" was not converted",1:Y1_" does not exist") D MES^XPDUTL(.ECDP) K ECDP Q:ECOK']"" D Q
...;Q:ECOK="" S ^ECJ(EC,0)=X,^("PRO")=0,DA=EC,DIK="^ECJ(" D IX^DIK S X=$P(^ECJ(0),"^",4)+1,$P(^(0),"^",3,4)=EC_"^"_X
.Q:ECOK="" S Z=$P(X,"^"),$P(Z,"-",4)=Y,Z1=+$P(X,"-",3) D:'$D(^EC(726,Z1,0))
..I '$D(^EC(726,Z1,0)) S Z1N=$S($P($G(^ECP(Z1,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN CATEGORY (#"_Z1_")"),^EC(726,Z1,0)=Z1N_"^"_DT,^EC(726,"B",Z1N,Z1)="",$P(^EC(726,0),"^",3)=Z1,$P(^EC(726,0),"^",4)=$P(^EC(726,0),"^",4)+1 K Z1N
.Q:ECOK="" S $P(X,"^")=Z,^ECJ(EC,0)=X,^("PRO")=Y,DA=EC,DIK="^ECJ(" D IX^DIK K DA,DIK
.Q:ECOK="" S X=$P(^ECJ(0),"^",4)+1,$P(^(0),"^",3,4)=EC_"^"_X
;
;
;Now the patient file
D MES^XPDUTL("Beginning conversion of Event Capture Patient "_$$HTE^XLFDT($H))
PAT ;
;
S ECI=0 F ECJ=1:1 S ECI=$O(^ECH(ECI)) Q:'ECI I $D(^(ECI,0)) S ECD=^(0) D
.F EC=11,15,17 S ECX=$P(ECD,"^",EC),ECX=$S(ECX="":"",ECX["VA(200,":+ECX,ECX["DIC(3.1,":$S($D(^DIC(3.1,+ECX,0)):$P(^(0),"^"),1:"UNKNOWN"),1:ECX),$P(ECD,"^",EC)=ECX
.S ECP=$P(ECD,"^",9) I ECP'[";" S ECP1=$G(^ECP(+ECP,"V")),ECP2=$P($G(^(0)),"^") D
..I ECP1="" S ECDP(1)="Entry number "_ECI_" was not converted",ECDP(2)="Procedure "_$S(ECP2]"":ECP2_" was not converted",1:ECP_" does not exist") D MES^XPDUTL(.ECDP) K ECDP Q
..S $P(ECD,"^",9)=ECP1
.I '$D(^EC(726,+$P(ECD,"^",8),0)) S $P(ECD,"^",8)=0
.S ^ECH(ECI,0)=ECD I ECJ#100=0 D MES^XPDUTL(".")
K EC,ECD,ECI,ECJ,ECX
D MES^XPDUTL("Conversion of Event Capture files completed "_$$HTE^XLFDT($H))
LOG D NOW^%DTC S EC=+%
S ^EC(720.1,1,0)="1^"_EC,^EC(720.1,"B",1,1)="",$P(^EC(720.1,0),"^",3,4)="1^1"
K %,%H,%I,EC,X
MSG ;send install msg
D MES^XPDUTL("Finished.")
;the following line is not used by KIDS
;S XQABT5=$H,X="ECINITY" X ^%ZOSF("TEST") I D @("^"_X)
K DA,DIK,EC,EC1,ECD,ECI,ECJ,ECN,ECNEW,ECOK,ECP,ECP1,ECP2,ECPT,ECX,X,Y,Y1,Z,Z1,Z1N
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECINCONV 3661 printed Dec 13, 2024@01:57:29 Page 2
ECINCONV ;BIR/DMA,JPW-Convert Procedures ;7 May 96
+1 ;;2.0; EVENT CAPTURE ;;8 May 96
+2 ;
EN ;entry point
+1 SET XQABT4=$HOROLOG
+2 DO MES^XPDUTL("Re-indexing the MEDICAL SPECIALTY file (#723)...")
+3 KILL ^ECC(723,"B")
KILL DIK
SET DIK="^ECC(723,"
DO IXALL^DIK
KILL DIK
+4 KILL ^EC(725,"B")
KILL DIK
SET DIK="^EC(725,"
SET DIK(1)=".01^B"
DO ENALL^DIK
KILL DIK
+5 DO MES^XPDUTL("Re-indexing completed.")
+6 IF $PIECE($GET(^EC(720.1,1,0)),"^",2)
GOTO MSG
+7 IF $DATA(^ECH(0))
IF '$ORDER(^ECH(0))
GOTO LOG
+8 DO MES^XPDUTL("Beginning conversion of procedures "_$$HTE^XLFDT($HOROLOG))
+9 IF '$DATA(DT)
SET DT=$$DT^XLFDT
+10 SET ECNEW=89999
SET EC=0
FOR
SET EC=$ORDER(^ECP(EC))
if 'EC
QUIT
IF $DATA(^(EC,0))
SET EC1=^(0)
SET ECN=$PIECE(EC1,"^",2)
Begin DoDot:1
+11 IF ECN=""
DO MES^XPDUTL("Procedure "_$PIECE(EC1,U)_" was not converted")
QUIT
+12 IF $PIECE(EC1,"^",3)
SET ^EC(726,EC,0)=$PIECE(EC1,"^")_"^"_DT
SET ^EC(726,"B",$PIECE(EC1,"^"),EC)=""
SET X=$PIECE(^EC(726,0),"^",4)+1
SET $PIECE(^(0),"^",3,4)=EC_"^"_X
+13 ;create category if appropriate
+14 SET ECPT=$ORDER(^ICPT("B",ECN,0))
IF ECPT
SET ^ECP(EC,"V")=ECPT_";ICPT("
QUIT
+15 SET ECP=$ORDER(^EC(725,"E",ECN,0))
IF ECP
SET ^ECP(EC,"V")=ECP_";EC(725,"
QUIT
+16 IF $ORDER(^EC(725,$EXTRACT(EC1,1,50),0))
QUIT
+17 IF ECN'?1U4AN
DO MES^XPDUTL("Procedure "_$PIECE(EC1,U)_" was not converted")
QUIT
+18 FOR
SET ECNEW=ECNEW+1
if '$DATA(^EC(725,ECNEW,0))
QUIT
+19 SET ^EC(725,ECNEW,0)=$PIECE(EC1,"^",1,2)
SET ^ECP(EC,"V")=ECNEW_";EC(725,"
SET DA=ECNEW
SET DIK="^EC(725,"
DO IX^DIK
SET X=$PIECE(^EC(725,0),"^",4)+1
SET $PIECE(^(0),"^",3,4)=ECNEW_"^"_X
End DoDot:1
+20 ;
+21 ;Now the event code screens
+22 DO MES^XPDUTL("Beginning the conversion of Event Code Screens "_$$HTE^XLFDT($HOROLOG))
CODES ;
+1 SET EC=0
FOR
SET EC=$ORDER(^ECK(EC))
if 'EC
QUIT
SET X=^(EC,0)
SET Y1=+$PIECE(X,"-",4)
SET (ECOK,Y)=$GET(^ECP(Y1,"V"))
IF $PIECE($PIECE(X,"^"),"-",4)'[";"
Begin DoDot:1
+2 IF Y=""
SET ECDP(1)="Event Code Screen "_$PIECE(X,U)_" was not converted"
SET ECDP(2)="It has been inactivated"
if $PIECE(X,"^",2)=""
SET $PIECE(X,"^",2)=DT
Begin DoDot:2
+3 SET ^ECK(EC,0)=X
SET ECDP(3)="Procedure "_$SELECT($DATA(^ECP(Y1,0)):$PIECE(^(0),U)_" was not converted",1:Y1_" does not exist")
DO MES^XPDUTL(.ECDP)
KILL ECDP
if ECOK']""
QUIT
Begin DoDot:3
+4 ;Q:ECOK="" S ^ECJ(EC,0)=X,^("PRO")=0,DA=EC,DIK="^ECJ(" D IX^DIK S X=$P(^ECJ(0),"^",4)+1,$P(^(0),"^",3,4)=EC_"^"_X
End DoDot:3
QUIT
End DoDot:2
+5 if ECOK=""
QUIT
SET Z=$PIECE(X,"^")
SET $PIECE(Z,"-",4)=Y
SET Z1=+$PIECE(X,"-",3)
if '$DATA(^EC(726,Z1,0))
Begin DoDot:2
+6 IF '$DATA(^EC(726,Z1,0))
SET Z1N=$SELECT($PIECE($GET(^ECP(Z1,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN CATEGORY (#"_Z1_")")
SET ^EC(726,Z1,0)=Z1N_"^"_DT
SET ^EC(726,"B",Z1N,Z1)=""
SET $PIECE(^EC(726,0),"^",3)=Z1
SET $PIECE(^EC(726,0),"^",4)=$PIECE(^EC(726,0),"^",4)+1
KILL Z1N
End DoDot:2
+7 if ECOK=""
QUIT
SET $PIECE(X,"^")=Z
SET ^ECJ(EC,0)=X
SET ^("PRO")=Y
SET DA=EC
SET DIK="^ECJ("
DO IX^DIK
KILL DA,DIK
+8 if ECOK=""
QUIT
SET X=$PIECE(^ECJ(0),"^",4)+1
SET $PIECE(^(0),"^",3,4)=EC_"^"_X
End DoDot:1
+9 ;
+10 ;
+11 ;Now the patient file
+12 DO MES^XPDUTL("Beginning conversion of Event Capture Patient "_$$HTE^XLFDT($HOROLOG))
PAT ;
+1 ;
+2 SET ECI=0
FOR ECJ=1:1
SET ECI=$ORDER(^ECH(ECI))
if 'ECI
QUIT
IF $DATA(^(ECI,0))
SET ECD=^(0)
Begin DoDot:1
+3 FOR EC=11,15,17
SET ECX=$PIECE(ECD,"^",EC)
SET ECX=$SELECT(ECX="":"",ECX["VA(200,":+ECX,ECX["DIC(3.1,":$SELECT($DATA(^DIC(3.1,+ECX,0)):$PIECE(^(0),"^"),1:"UNKNOWN"),1:ECX)
SET $PIECE(ECD,"^",EC)=ECX
+4 SET ECP=$PIECE(ECD,"^",9)
IF ECP'[";"
SET ECP1=$GET(^ECP(+ECP,"V"))
SET ECP2=$PIECE($GET(^(0)),"^")
Begin DoDot:2
+5 IF ECP1=""
SET ECDP(1)="Entry number "_ECI_" was not converted"
SET ECDP(2)="Procedure "_$SELECT(ECP2]"":ECP2_" was not converted",1:ECP_" does not exist")
DO MES^XPDUTL(.ECDP)
KILL ECDP
QUIT
+6 SET $PIECE(ECD,"^",9)=ECP1
End DoDot:2
+7 IF '$DATA(^EC(726,+$PIECE(ECD,"^",8),0))
SET $PIECE(ECD,"^",8)=0
+8 SET ^ECH(ECI,0)=ECD
IF ECJ#100=0
DO MES^XPDUTL(".")
End DoDot:1
+9 KILL EC,ECD,ECI,ECJ,ECX
+10 DO MES^XPDUTL("Conversion of Event Capture files completed "_$$HTE^XLFDT($HOROLOG))
LOG DO NOW^%DTC
SET EC=+%
+1 SET ^EC(720.1,1,0)="1^"_EC
SET ^EC(720.1,"B",1,1)=""
SET $PIECE(^EC(720.1,0),"^",3,4)="1^1"
+2 KILL %,%H,%I,EC,X
MSG ;send install msg
+1 DO MES^XPDUTL("Finished.")
+2 ;the following line is not used by KIDS
+3 ;S XQABT5=$H,X="ECINITY" X ^%ZOSF("TEST") I D @("^"_X)
+4 KILL DA,DIK,EC,EC1,ECD,ECI,ECJ,ECN,ECNEW,ECOK,ECP,ECP1,ECP2,ECPT,ECX,X,Y,Y1,Z,Z1,Z1N
+5 QUIT
