DG53729R.m

DG53729R ;ALB/JRC - Add NURSING HOME TREATING SPECIALTIES ; 2/21/07 12:31pm

 ;;5.3;Registration;**729,1015**;Aug 13, 1993;Build 21

 ;Continuation of DG53729P

 ;

EDIT ;Edit surgical specialties

 N DS,DIE,DR,DGI,DGCD

 S DIE="^DIC(45.3,"

 S DIC(0)="X"

 F DGI=1:1 S DGSPEC=$P($T(ESURGSP+DGI),";;",2) Q:DGSPEC="QUIT"  D

 .S DGERR=0

 .S DGCD=$P(DGSPEC,U)

 .S DGSPEC1=0 F DGII=0:0 S DGSPEC1=$O(^DIC(45.3,"B",DGCD,DGSPEC1)) Q:'DGSPEC1  D

 ..S DA=DGSPEC1,DR="1///"_$P(DGSPEC,U,2)

 ..D ^DIE

 ..D BMES^XPDUTL(" ")

 ..D BMES^XPDUTL(" ")

 ..D BMES^XPDUTL(">>>"_$P(DGSPEC,U)_" code updated to "_$P(DGSPEC,U,2)_" in the Surgical Specialty file.>>>")

 Q

 ;

ESURGSP ;;Code^Specialty

 ;;50^GENERAL SURGERY

 ;;51^OB/GYN

 ;;55^EAR, NOSE, THROAT (ENT)

 ;;56^PLASTIC SURGERY

 ;;58^THORACIC SURGERY

 ;;60^ORAL SURGERY

 ;;QUIT

 Q

 ;

PTFCAT ;Place inactive date in PTF EXPANDED CODE CATEGORY (#.03) field

 ;Temporarily remove 'no editing' from Data Dictionary

 N SAVXI,SAVXF,SAVXC,XI,XF,XC

 S SAVXF=$P(^DD(45.88,.02,0),U,2) ;Flag field

 S XF=$P(SAVXF,"I",1)_$P(SAVXF,"I",2,99) ;REMOVE THE 'I'

 S SAVXI=$P(^DD(45.88,.03,0),U,2) ;Inactive Date field

 S XI=$P(SAVXI,"I",1)_$P(SAVXI,"I",2,99) ;REMOVE THE 'I'

 S SAVXC=$P(^DD(45.89,.01,0),U,2) ;Category field

 S XC=$P(SAVXC,"I",1)_$P(SAVXC,"I",2,99) ;REMOVE THE 'I'

 S $P(^DD(45.88,.02,0),U,2)=XF

 S $P(^DD(45.88,.03,0),U,2)=XI

 S $P(^DD(45.89,.01,0),U,2)=XC

 N I,CAT,DIC,DIE,DR,X,Y,DGPCD

 F I=1:1 S CAT=$P($T(PTFCAT1+I),";;",2) Q:CAT="QUIT"  D

 . S DIC="^DIC(45.88,",DIC(0)="X"

 . S X=$P(CAT,"^")

 . I $P(CAT,"^")="DIALYSIS TYPE" S DIC(0)="LM"

 . D ^DIC

 . I +Y>0 D

 .. S DIE=DIC,DA=+Y

 .. S DR=".03////"_$P(CAT,"^",2)

 .. I $P(CAT,"^")="DIALYSIS TYPE" S DR=".02///8"

 .. D ^DIE

 ..I $P(CAT,"^")="DIALYSIS TYPE" D

 ...D BMES^XPDUTL(">>>"_$P(CAT,"^")_" added to the PTF EXPANDED CODE CATEGORY File (#45.88).")

 ..E  D

 ...D BMES^XPDUTL(">>>Inactive date added to category "_$P(CAT,"^")_" in the")

 ...D MES^XPDUTL("   PTF EXPANDED CODE CATEGORY File (#45.88).<<<")

 ;In file 45.89, add procedure codes to newly added DIALYSIS TYPE

 F DGPCD=39.95,54.98,50.92 D

 .S DIC="^ICD0(",DIC(0)="MX",X=DGPCD D ^DIC

 .Q:+Y'>0

 .I $D(^DIC(45.89,"ASPL",+Y_";ICD0(")) D  Q

 ..D MES^XPDUTL(">>>>Entry "_$P(Y,U,2)_" exists in PTF EXPANDED CODE File (#45.89).")

 .S DIC="^DIC(45.89,",DIC(0)=""

 .S DIC("DR")=".01///6"_";.02///"_DGPCD,X="DIALYSIS TYPE"

 .K D0 D FILE^DICN

 .I +Y<0 D  Q

 ..D MES^XPDUTL(">>>>Entry not added to PTF EXPANDED CODE File (#45.89).  No further updating will occur.")

 ..D MES^XPDUTL("   Please contact Customer Service for assistance.")

 .D MES^XPDUTL(">>>>Entry "_$S($P(Y,U,3)=1:"added to",1:"exists in")_" PTF EXPANDED CODE File (#45.89).")

 ;Place 'old' value back into Data Dictionary

 S $P(^DD(45.88,.02,0),U,2)=SAVXF

 S $P(^DD(45.88,.03,0),U,2)=SAVXI

 S $P(^DD(45.89,.01,0),U,2)=SAVXC

 K DIC,DIE,DA,DR,Y,X

 ;

 ;-Remove DIALYSIS TYPE trigger xref.

 I $D(^DD(45.05,2,1,1)) D

 .D BMES^XPDUTL(">>>Removing DIALYSIS TYPE trigger cross-reference.")

 .D DELIX^DDMOD(45.05,2,1)

 Q

PTFCAT1 ;- PTF EXPANDED CODE CATEGORY items to inactivate

 ;;KIDNEY TRANSPLANT STATUS^3060701

 ;;SUICIDE INDICATOR^3060701

 ;;LEGIONNAIRE'S DISEASE^3060701

 ;;SUBSTANCE ABUSE^3060701

 ;;DIALYSIS TYPE^^8

 ;;QUIT

DG53729R  ;ALB/JRC - Add NURSING HOME TREATING SPECIALTIES ; 2/21/07 12:31pm

 +1       ;;5.3;Registration;**729,1015**;Aug 13, 1993;Build 21

 +2       ;Continuation of DG53729P

 +3       ;

EDIT      ;Edit surgical specialties

 +1        NEW DS,DIE,DR,DGI,DGCD

 +2        SET DIE="^DIC(45.3,"

 +3        SET DIC(0)="X"

 +4        FOR DGI=1:1

               SET DGSPEC=$PIECE($TEXT(ESURGSP+DGI),";;",2)

               IF DGSPEC="QUIT"

                   QUIT 

               Begin DoDot:1

 +5                SET DGERR=0

 +6                SET DGCD=$PIECE(DGSPEC,U)

 +7                SET DGSPEC1=0

                   FOR DGII=0:0

                       SET DGSPEC1=$ORDER(^DIC(45.3,"B",DGCD,DGSPEC1))

                       IF 'DGSPEC1

                           QUIT 

                       Begin DoDot:2

 +8                        SET DA=DGSPEC1

                           SET DR="1///"_$PIECE(DGSPEC,U,2)

 +9                        DO ^DIE

 +10                       DO BMES^XPDUTL(" ")

 +11                       DO BMES^XPDUTL(" ")

 +12                       DO BMES^XPDUTL(">>>"_$PIECE(DGSPEC,U)_" code updated to "_$PIECE(DGSPEC,U,2)_" in the Surgical Specialty file.>>>")

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

 +14      ;

ESURGSP   ;;Code^Specialty

 +1       ;;50^GENERAL SURGERY

 +2       ;;51^OB/GYN

 +3       ;;55^EAR, NOSE, THROAT (ENT)

 +4       ;;56^PLASTIC SURGERY

 +5       ;;58^THORACIC SURGERY

 +6       ;;60^ORAL SURGERY

 +7       ;;QUIT

 +8        QUIT 

 +9       ;

PTFCAT    ;Place inactive date in PTF EXPANDED CODE CATEGORY (#.03) field

 +1       ;Temporarily remove 'no editing' from Data Dictionary

 +2        NEW SAVXI,SAVXF,SAVXC,XI,XF,XC

 +3       ;Flag field

           SET SAVXF=$PIECE(^DD(45.88,.02,0),U,2)

 +4       ;REMOVE THE 'I'

           SET XF=$PIECE(SAVXF,"I",1)_$PIECE(SAVXF,"I",2,99)

 +5       ;Inactive Date field

           SET SAVXI=$PIECE(^DD(45.88,.03,0),U,2)

 +6       ;REMOVE THE 'I'

           SET XI=$PIECE(SAVXI,"I",1)_$PIECE(SAVXI,"I",2,99)

 +7       ;Category field

           SET SAVXC=$PIECE(^DD(45.89,.01,0),U,2)

 +8       ;REMOVE THE 'I'

           SET XC=$PIECE(SAVXC,"I",1)_$PIECE(SAVXC,"I",2,99)

 +9        SET $PIECE(^DD(45.88,.02,0),U,2)=XF

 +10       SET $PIECE(^DD(45.88,.03,0),U,2)=XI

 +11       SET $PIECE(^DD(45.89,.01,0),U,2)=XC

 +12       NEW I,CAT,DIC,DIE,DR,X,Y,DGPCD

 +13       FOR I=1:1

               SET CAT=$PIECE($TEXT(PTFCAT1+I),";;",2)

               IF CAT="QUIT"

                   QUIT 

               Begin DoDot:1

 +14               SET DIC="^DIC(45.88,"

                   SET DIC(0)="X"

 +15               SET X=$PIECE(CAT,"^")

 +16               IF $PIECE(CAT,"^")="DIALYSIS TYPE"

                       SET DIC(0)="LM"

 +17               DO ^DIC

 +18               IF +Y>0

                       Begin DoDot:2

 +19                       SET DIE=DIC

                           SET DA=+Y

 +20                       SET DR=".03////"_$PIECE(CAT,"^",2)

 +21                       IF $PIECE(CAT,"^")="DIALYSIS TYPE"

                               SET DR=".02///8"

 +22                       DO ^DIE

 +23                       IF $PIECE(CAT,"^")="DIALYSIS TYPE"

                               Begin DoDot:3

 +24                               DO BMES^XPDUTL(">>>"_$PIECE(CAT,"^")_" added to the PTF EXPANDED CODE CATEGORY File (#45.88).")

                               End DoDot:3

 +25                      IF '$TEST

                               Begin DoDot:3

 +26                               DO BMES^XPDUTL(">>>Inactive date added to category "_$PIECE(CAT,"^")_" in the")

 +27                               DO MES^XPDUTL("   PTF EXPANDED CODE CATEGORY File (#45.88).<<<")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +28      ;In file 45.89, add procedure codes to newly added DIALYSIS TYPE

 +29       FOR DGPCD=39.95,54.98,50.92

               Begin DoDot:1

 +30               SET DIC="^ICD0("

                   SET DIC(0)="MX"

                   SET X=DGPCD

                   DO ^DIC

 +31               IF +Y'>0

                       QUIT 

 +32               IF $DATA(^DIC(45.89,"ASPL",+Y_";ICD0("))

                       Begin DoDot:2

 +33                       DO MES^XPDUTL(">>>>Entry "_$PIECE(Y,U,2)_" exists in PTF EXPANDED CODE File (#45.89).")

                       End DoDot:2

                       QUIT 

 +34               SET DIC="^DIC(45.89,"

                   SET DIC(0)=""

 +35               SET DIC("DR")=".01///6"_";.02///"_DGPCD

                   SET X="DIALYSIS TYPE"

 +36               KILL D0

                   DO FILE^DICN

 +37               IF +Y<0

                       Begin DoDot:2

 +38                       DO MES^XPDUTL(">>>>Entry not added to PTF EXPANDED CODE File (#45.89).  No further updating will occur.")

 +39                       DO MES^XPDUTL("   Please contact Customer Service for assistance.")

                       End DoDot:2

                       QUIT 

 +40               DO MES^XPDUTL(">>>>Entry "_$SELECT($PIECE(Y,U,3)=1:"added to",1:"exists in")_" PTF EXPANDED CODE File (#45.89).")

               End DoDot:1

 +41      ;Place 'old' value back into Data Dictionary

 +42       SET $PIECE(^DD(45.88,.02,0),U,2)=SAVXF

 +43       SET $PIECE(^DD(45.88,.03,0),U,2)=SAVXI

 +44       SET $PIECE(^DD(45.89,.01,0),U,2)=SAVXC

 +45       KILL DIC,DIE,DA,DR,Y,X

 +46      ;

 +47      ;-Remove DIALYSIS TYPE trigger xref.

 +48       IF $DATA(^DD(45.05,2,1,1))

               Begin DoDot:1

 +49               DO BMES^XPDUTL(">>>Removing DIALYSIS TYPE trigger cross-reference.")

 +50               DO DELIX^DDMOD(45.05,2,1)

               End DoDot:1

 +51       QUIT 

PTFCAT1   ;- PTF EXPANDED CODE CATEGORY items to inactivate

 +1       ;;KIDNEY TRANSPLANT STATUS^3060701

 +2       ;;SUICIDE INDICATOR^3060701

 +3       ;;LEGIONNAIRE'S DISEASE^3060701

 +4       ;;SUBSTANCE ABUSE^3060701

 +5       ;;DIALYSIS TYPE^^8

 +6       ;;QUIT