- ECX3P87P ;ALB/JAP - National Clinic Update ;July 06, 2005
- ;;3.0;DSS EXTRACTS;**87**;Dec 22, 1997
- ;
- ADD7272 ;** Add entries to file #727.2
- ;ECXX is in format: ien;test^source
- N ECX,ECXX,DA,DIC,DIE,DR,DINUM,X,Y,TEST,SOURCE
- 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)=""
- 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 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 MESS
- S $P(^DD(727.21,.01,0),U,5)="K X"
- Q
- ;
- MESS ;** Add message
- N ECXADMSG
- S ECXADMSG=" "_TEST
- D MES^XPDUTL(ECXADMSG)
- S ECXADMSG=" added as record #"_ECXDA_"."
- D MES^XPDUTL(ECXADMSG)
- D MES^XPDUTL(" ")
- Q
- ;
- MESS2 ;** Add message
- N ECXADMSG
- S ECXADMSG=" "_A1_" - "_A3
- D MES^XPDUTL(ECXADMSG)
- S ECXADMSG=" added as record #"_ECXDA_"."
- D MES^XPDUTL(ECXADMSG)
- D MES^XPDUTL(" ")
- Q
- ;
- CLEAN2 ;delete records added to file #727.2
- N ECX,X,Y,DA,DIK,DIC,JJ,SS
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" This subroutine will delete those entries in file #727.2,")
- D MES^XPDUTL(" DSS LAB TESTS File, which were added by patch ECX*3.0*8.")
- D MES^XPDUTL(" ")
- I $E(IOST)="C" D Q:'Y
- .S SS=22-$Y F JJ=1:1:SS W !
- .K X,Y
- .S DIR(0)="E" W ! D ^DIR K DIR
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" Deleting...")
- D MES^XPDUTL(" ")
- F ECX=13:1:31 D
- .S DA=ECX,DA(1)=1,DIK="^ECX(727.2,1,1,"
- .D ^DIK
- D MES^XPDUTL(" ")
- D MES^XPDUTL(" Done.")
- D MES^XPDUTL(" ")
- Q
- ;
- NEW7272 ;new records for file #727.2
- ;;60;Bilirubin, Direct^B
- ;;61;C Reactive Protein^B
- ;;62;C Reactive Protein HS^B
- ;;63;Calcium, Serum^B
- ;;64;Carbon Dioxide^B
- ;;65;Chloride^B
- ;;66;Creatinine eGFR^B
- ;;67;B Natriuretic Peptide^B
- ;;68;O2 Saturation^B
- ;;69;PO2^B
- ;;70;PCO2^B
- ;;71;Total Protein^B
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P87P 2142 printed Feb 18, 2025@23:17:12 Page 2
- ECX3P87P ;ALB/JAP - National Clinic Update ;July 06, 2005
- +1 ;;3.0;DSS EXTRACTS;**87**;Dec 22, 1997
- +2 ;
- ADD7272 ;** Add entries to file #727.2
- +1 ;ECXX is in format: ien;test^source
- +2 NEW ECX,ECXX,DA,DIC,DIE,DR,DINUM,X,Y,TEST,SOURCE
- +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)=""
- +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 TEST=$PIECE(ECXX,U,1)
- SET SOURCE=$PIECE(ECXX,U,2)
- +13 SET DA(1)=1
- SET DIC("P")=$PIECE(^DD(727.2,1,0),U,2)
- SET DINUM=ECXDA
- +14 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"
- +15 KILL DD,DO
- DO FILE^DICN
- KILL DLAYGO
- +16 DO MESS
- End DoDot:2
- End DoDot:1
- +17 SET $PIECE(^DD(727.21,.01,0),U,5)="K X"
- +18 QUIT
- +19 ;
- MESS ;** Add message
- +1 NEW ECXADMSG
- +2 SET ECXADMSG=" "_TEST
- +3 DO MES^XPDUTL(ECXADMSG)
- +4 SET ECXADMSG=" added as record #"_ECXDA_"."
- +5 DO MES^XPDUTL(ECXADMSG)
- +6 DO MES^XPDUTL(" ")
- +7 QUIT
- +8 ;
- MESS2 ;** Add message
- +1 NEW ECXADMSG
- +2 SET ECXADMSG=" "_A1_" - "_A3
- +3 DO MES^XPDUTL(ECXADMSG)
- +4 SET ECXADMSG=" added as record #"_ECXDA_"."
- +5 DO MES^XPDUTL(ECXADMSG)
- +6 DO MES^XPDUTL(" ")
- +7 QUIT
- +8 ;
- CLEAN2 ;delete records added to file #727.2
- +1 NEW ECX,X,Y,DA,DIK,DIC,JJ,SS
- +2 DO MES^XPDUTL(" ")
- +3 DO MES^XPDUTL(" This subroutine will delete those entries in file #727.2,")
- +4 DO MES^XPDUTL(" DSS LAB TESTS File, which were added by patch ECX*3.0*8.")
- +5 DO MES^XPDUTL(" ")
- +6 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +7 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +8 KILL X,Y
- +9 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- if 'Y
- QUIT
- +10 DO MES^XPDUTL(" ")
- +11 DO MES^XPDUTL(" Deleting...")
- +12 DO MES^XPDUTL(" ")
- +13 FOR ECX=13:1:31
- Begin DoDot:1
- +14 SET DA=ECX
- SET DA(1)=1
- SET DIK="^ECX(727.2,1,1,"
- +15 DO ^DIK
- End DoDot:1
- +16 DO MES^XPDUTL(" ")
- +17 DO MES^XPDUTL(" Done.")
- +18 DO MES^XPDUTL(" ")
- +19 QUIT
- +20 ;
- NEW7272 ;new records for file #727.2
- +1 ;;60;Bilirubin, Direct^B
- +2 ;;61;C Reactive Protein^B
- +3 ;;62;C Reactive Protein HS^B
- +4 ;;63;Calcium, Serum^B
- +5 ;;64;Carbon Dioxide^B
- +6 ;;65;Chloride^B
- +7 ;;66;Creatinine eGFR^B
- +8 ;;67;B Natriuretic Peptide^B
- +9 ;;68;O2 Saturation^B
- +10 ;;69;PO2^B
- +11 ;;70;PCO2^B
- +12 ;;71;Total Protein^B
- +13 ;;QUIT