- 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 Jan 18, 2025@02:58:42 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