DG53729R ;ALB/JRC - Add NURSING HOME TREATING SPECIALTIES ; 2/21/07 12:31pm
;;5.3;Registration;**729**;Aug 13, 1993;Build 59
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53729R 3302 printed Apr 09, 2024@22:02:14 Page 2
DG53729R ;ALB/JRC - Add NURSING HOME TREATING SPECIALTIES ; 2/21/07 12:31pm
+1 ;;5.3;Registration;**729**;Aug 13, 1993;Build 59
+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
