- ECX333PT ;ALB/JAM - PATCH ECX*3.0*33 Post-Init Rtn ; 06/07/00
- ;;3.0;DSS EXTRACTS;**33**;Jun 07, 2000
- ;
- ;post-init routine to add new entries to file 727.831 and add LAR codes
- ;
- D DOMADD
- D ADD7272
- Q
- DOMADD ;* add entries to file 727.831
- ;
- ; ECXX is in format:
- ; TREATING SPECIALTY IEN TO ADD^DSS DOM CODE^IN/OUT CODE
- ;
- N ECX,ECXX,LOC,CODE,INOUT,X,Y,DIC,DA,DR,DLAYGO,DINUM
- D MES^XPDUTL(" ")
- D BMES^XPDUTL("Adding entries to DOM PRRTP SAARTP ETC File (#727.831)...")
- F ECX=1:1 S ECXX=$P($T(NEW+ECX),";;",2) Q:ECXX="QUIT" D
- .S LOC=$P(ECXX,U),CODE=$P(ECXX,U,2),INOUT=$P(ECXX,U,3)
- .I '$D(^ECX(727.831,LOC)) D Q
- ..S X=LOC,DINUM=X,DIC(0)="L",DLAYGO=727.831,DIC="^ECX(727.831,"
- ..S DIC("DR")="2////^S X=CODE;3////^S X=INOUT"
- ..D FILE^DICN I +Y>0 D Q
- ...D BMES^XPDUTL(" Treating Specialty "_LOC_" ...successfully added.")
- ..D BMES^XPDUTL("ERROR when attempting to add Treating Specialty "_LOC)
- .D BMES^XPDUTL(" Treating Specialty "_LOC_" already added.")
- Q
- NEW ;treating speciality ien to add^dss dom code^in/out code
- ;;25^P^3
- ;;26^T^3
- ;;27^S^3
- ;;28^H^3
- ;;29^A^3
- ;;37^D^3
- ;;38^B^3
- ;;39^C^3
- ;;85^D^3
- ;;86^D^3
- ;;87^D^3
- ;;88^D^3
- ;;QUIT
- ADD7272 ;add entries to file #727.2
- ;ECXX is in format: ien;test^source
- N ECX,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" Adding entries to DSS LAB TESTS File (#727.2)...")
- D MES^XPDUTL(" ")
- S $P(^DD(727.21,.01,0),U,5)="",CNT=0
- F ECX=1:1 S ECXX=$P($T(NEW7272+ECX),";;",2) Q:ECXX="QUIT" D
- .S ECXDA=$P(ECXX,";",1),ECXX=$P(ECXX,";",2)
- .Q:'$D(^ECX(727.2,1))
- .I $D(^ECX(727.2,1,1,0)),'$D(^ECX(727.2,1,1,ECXDA,0)) D
- ..S CNT=CNT+1
- ..S TEST=$P(ECXX,U,1),SOURCE=$P(ECXX,U,2)
- ..S DA(1)=1,DIC("P")=$P(^DD(727.2,1,0),U,2),DINUM=ECXDA
- ..S X=TEST,DIC="^ECX(727.2,1,1,",DLAYGO=727.21,DIC(0)="LX",DIC("DR")="2///^S X=SOURCE"
- ..K DD,DO D FILE^DICN K DLAYGO
- ..D MES^XPDUTL(" ")
- ..D MES^XPDUTL(" Adding "_TEST_" as entry #"_ECXDA_"... ok.")
- ..D MES^XPDUTL(" ")
- I CNT=0 D
- .D MES^XPDUTL(" Entries already exist -- nothing added.")
- .D MES^XPDUTL(" ")
- S $P(^DD(727.21,.01,0),U,5)="K X"
- Q
- ;
- NEW7272 ;new records for file #727.2
- ;;41;HEPATITIS A AB^B
- ;;42;HEPATITIS A IGM AB^B
- ;;43;HEPATITIS A, IGG AB^B
- ;;44;BILIRUBIN, TOTAL^B
- ;;45;ALT (TRANSFERASE ALANINE AMINO)^B
- ;;46;HEPATITIS B CORE AB^B
- ;;47;HEPATITIS B E AG^B
- ;;48;PHOSPHATASE ALKALINE^B
- ;;49;ALBUMIN^B
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX333PT 2483 printed Apr 23, 2025@18:04:22 Page 2
- ECX333PT ;ALB/JAM - PATCH ECX*3.0*33 Post-Init Rtn ; 06/07/00
- +1 ;;3.0;DSS EXTRACTS;**33**;Jun 07, 2000
- +2 ;
- +3 ;post-init routine to add new entries to file 727.831 and add LAR codes
- +4 ;
- +5 DO DOMADD
- +6 DO ADD7272
- +7 QUIT
- DOMADD ;* add entries to file 727.831
- +1 ;
- +2 ; ECXX is in format:
- +3 ; TREATING SPECIALTY IEN TO ADD^DSS DOM CODE^IN/OUT CODE
- +4 ;
- +5 NEW ECX,ECXX,LOC,CODE,INOUT,X,Y,DIC,DA,DR,DLAYGO,DINUM
- +6 DO MES^XPDUTL(" ")
- +7 DO BMES^XPDUTL("Adding entries to DOM PRRTP SAARTP ETC File (#727.831)...")
- +8 FOR ECX=1:1
- SET ECXX=$PIECE($TEXT(NEW+ECX),";;",2)
- if ECXX="QUIT"
- QUIT
- Begin DoDot:1
- +9 SET LOC=$PIECE(ECXX,U)
- SET CODE=$PIECE(ECXX,U,2)
- SET INOUT=$PIECE(ECXX,U,3)
- +10 IF '$DATA(^ECX(727.831,LOC))
- Begin DoDot:2
- +11 SET X=LOC
- SET DINUM=X
- SET DIC(0)="L"
- SET DLAYGO=727.831
- SET DIC="^ECX(727.831,"
- +12 SET DIC("DR")="2////^S X=CODE;3////^S X=INOUT"
- +13 DO FILE^DICN
- IF +Y>0
- Begin DoDot:3
- +14 DO BMES^XPDUTL(" Treating Specialty "_LOC_" ...successfully added.")
- End DoDot:3
- QUIT
- +15 DO BMES^XPDUTL("ERROR when attempting to add Treating Specialty "_LOC)
- End DoDot:2
- QUIT
- +16 DO BMES^XPDUTL(" Treating Specialty "_LOC_" already added.")
- End DoDot:1
- +17 QUIT
- NEW ;treating speciality ien to add^dss dom code^in/out code
- +1 ;;25^P^3
- +2 ;;26^T^3
- +3 ;;27^S^3
- +4 ;;28^H^3
- +5 ;;29^A^3
- +6 ;;37^D^3
- +7 ;;38^B^3
- +8 ;;39^C^3
- +9 ;;85^D^3
- +10 ;;86^D^3
- +11 ;;87^D^3
- +12 ;;88^D^3
- +13 ;;QUIT
- ADD7272 ;add entries to file #727.2
- +1 ;ECXX is in format: ien;test^source
- +2 NEW ECX,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
- +3 DO MES^XPDUTL(" ")
- +4 DO MES^XPDUTL(" ")
- +5 DO MES^XPDUTL(" Adding entries to DSS LAB TESTS File (#727.2)...")
- +6 DO MES^XPDUTL(" ")
- +7 SET $PIECE(^DD(727.21,.01,0),U,5)=""
- SET CNT=0
- +8 FOR ECX=1:1
- SET ECXX=$PIECE($TEXT(NEW7272+ECX),";;",2)
- if ECXX="QUIT"
- QUIT
- Begin DoDot:1
- +9 SET ECXDA=$PIECE(ECXX,";",1)
- SET ECXX=$PIECE(ECXX,";",2)
- +10 if '$DATA(^ECX(727.2,1))
- QUIT
- +11 IF $DATA(^ECX(727.2,1,1,0))
- IF '$DATA(^ECX(727.2,1,1,ECXDA,0))
- Begin DoDot:2
- +12 SET CNT=CNT+1
- +13 SET TEST=$PIECE(ECXX,U,1)
- SET SOURCE=$PIECE(ECXX,U,2)
- +14 SET DA(1)=1
- SET DIC("P")=$PIECE(^DD(727.2,1,0),U,2)
- SET DINUM=ECXDA
- +15 SET X=TEST
- SET DIC="^ECX(727.2,1,1,"
- SET DLAYGO=727.21
- SET DIC(0)="LX"
- SET DIC("DR")="2///^S X=SOURCE"
- +16 KILL DD,DO
- DO FILE^DICN
- KILL DLAYGO
- +17 DO MES^XPDUTL(" ")
- +18 DO MES^XPDUTL(" Adding "_TEST_" as entry #"_ECXDA_"... ok.")
- +19 DO MES^XPDUTL(" ")
- End DoDot:2
- End DoDot:1
- +20 IF CNT=0
- Begin DoDot:1
- +21 DO MES^XPDUTL(" Entries already exist -- nothing added.")
- +22 DO MES^XPDUTL(" ")
- End DoDot:1
- +23 SET $PIECE(^DD(727.21,.01,0),U,5)="K X"
- +24 QUIT
- +25 ;
- NEW7272 ;new records for file #727.2
- +1 ;;41;HEPATITIS A AB^B
- +2 ;;42;HEPATITIS A IGM AB^B
- +3 ;;43;HEPATITIS A, IGG AB^B
- +4 ;;44;BILIRUBIN, TOTAL^B
- +5 ;;45;ALT (TRANSFERASE ALANINE AMINO)^B
- +6 ;;46;HEPATITIS B CORE AB^B
- +7 ;;47;HEPATITIS B E AG^B
- +8 ;;48;PHOSPHATASE ALKALINE^B
- +9 ;;49;ALBUMIN^B
- +10 ;;QUIT
