- DG53683P ;ALB/DHH - Add NURSING HOME TREATING SPECIALTIES ; 11/01/05
- ;;5.3;Registration;**683**;Nov 1, 2005
- ;base program: DG53176P
- ;
- EN ;Add Treating Specialties to the SPECIALITY file (#42.4)
- N DGI,DGERR,DGSPEC,DGIFN,DGQUES
- S DGIFN=0
- F DGI=1:1 S DGSPEC=$P($T(TRSP+DGI),";;",2) Q:DGSPEC="QUIT" D
- .D TSPEC
- .S DGQUES=$P(DGSPEC,U,9)
- .D FAC
- .Q
- D EDIT
- D INACT80,INACT
- Q
- TSPEC ;Add treating specialty to SPECIALTY File (#42.4)
- D BMES^XPDUTL(">>>"_$P(DGSPEC,U,2)_">>>")
- N DA,DGFILE,DGMULT,DIC,DIE,DGDA1,DINUM,DLAYGO,DR,X,Y
- S DGERR=0
- S DIC="^DIC(42.4,"
- S DIC(0)="LX"
- S DINUM=$P(DGSPEC,U)
- S X=$P(DGSPEC,U,2)
- S DLAYGO=42.4
- D ^DIC
- S (DGIFN,DGDA1)=Y
- I +DGIFN=-1 D Q
- .D MES^XPDUTL(" Entry not added to SPECIALTY File (#42.4). No further updating will occur.")
- .D MES^XPDUTL(" Please contact Customer Service for assistance.")
- .Q
- I $P(DGIFN,U,3)'=1&(+DGIFN'=$P(DGSPEC,U)) D Q
- .D MES^XPDUTL(" Entry exists in SPECIALTY File (#42.4), but with a different PTF Code #.")
- .D MES^XPDUTL(" No further updating will occur. Please review entry.")
- .S DGERR=1
- .Q
- D MES^XPDUTL(" Entry "_$S($P(DGIFN,U,3)=1:"added to",1:"exists in")_" SPECIALTY File (#42.4).")
- D MES^XPDUTL(" Updating SPECIALTY File fields.")
- S DIE=DIC
- S DR="1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7)
- S DA=+DGIFN
- D ^DIE
- S DGFILE=42.4
- S DGMULT=10
- S DIC="^DIC(42.4,"_+DGIFN_",""E"","
- D MULT
- Q
- FAC ;Add treating specialty to Facility Treating Specialty file (#45.7)
- N DA,DGFILE,DGMULT,DIC,DIE,DLAYGO,DR,X,Y
- S DIC="^DIC(45.7,"
- S DIC(0)="LXZ"
- S DLAYGO=45.7
- S X=$P(DGSPEC,U,2)
- D ^DIC
- S DGDA1=Y
- I +DGDA1=-1 D BMES^XPDUTL(" Entry not added to FACILITY TREATING SPECIALTY File(#45.7).") Q
- I $P(DGDA1,U,3)'=1&($P(Y(0),U,2)'=$P(DGSPEC,U)) D Q
- .D BMES^XPDUTL(" Entry exists in FACILITY TREATING SPECIALTY File (#45.7), but with")
- .D MES^XPDUTL(" a different PTF Code #. No further updating will occur.")
- .D MES^XPDUTL(" Please review entry.")
- .Q
- D BMES^XPDUTL(" Entry "_$S($P(DGDA1,U,3)=1:"added to",1:"exists in")_" FACILITY TREATING SPECIALTY File (#45.7).")
- D MES^XPDUTL(" Updating SPECIALTY field...")
- S DIE=DIC
- S DA=+DGDA1
- S DR="1////"_$P(DGSPEC,U)
- D ^DIE
- S DGFILE=45.7
- S DGMULT=100
- S DIC="^DIC(45.7,"_+DGDA1_",""E"","
- D MULT
- Q
- MULT ;Add Effective Date
- N DA,DIE,DR
- S DA(1)=+DGDA1
- S DIC(0)="LX"
- S DIC("P")=$P(^DD(DGFILE,DGMULT,0),"^",2)
- S X=3060701
- D ^DIC
- S DA=+Y
- I +Y=-1 D MES^XPDUTL(" Effective date not added.") Q
- D MES^XPDUTL(" Effective date added.")
- S DIE=DIC
- S DR=".02///Y"
- D ^DIE
- Q
- INACT80 ;inactivate code 80
- N DA,DIE,DR,X
- S DIC="^DIC(42.4,80,""E"","
- S DA(1)=80
- S DIC(0)="LX"
- S DIC("P")=$P(^DD(42.4,10,0),"^",2)
- S X=3060802
- D ^DIC
- S DA=+Y
- D BMES^XPDUTL(" ")
- D BMES^XPDUTL(" ")
- D BMES^XPDUTL(" ")
- I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to 80-NHCU in the Specialty file.") Q
- D BMES^XPDUTL(">>>Inactive date added to 80-NHCU in the Specialty file.<<<")
- S DIE=DIC
- S DR=".02///N"
- D ^DIE
- ;
- ; -- check for NHCU 80 in the Facility Treating Specialty File (45.7
- ; add inactivation date of 8/2/2006
- ;
- D BMES^XPDUTL(" ")
- D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
- D MES^XPDUTL(" pointing to 80-NHCU. If so, they will be inactivated.>>>")
- N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",80,DAA)) Q:'DAA D
- . N DIE,DR,TS,X S TS=""
- .S TS=$P($G(^DIC(45.7,DAA,0)),"^")
- .S DIC="^DIC(45.7,"_DAA_",""E"","
- .S DA(1)=DAA
- .S DIC(0)="LX"
- .S X=3060802
- .D ^DIC
- .S DA=+Y
- .I +Y=-1 D BMES^XPDUTL(" Inactive date not added to "_TS_" in the Facility Treating Specialty file.") Q
- . D BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.")
- .S DIE=DIC
- .S DR=".02///N"
- .D ^DIE
- Q
- INACT ;inactivate mental health codes
- N DA,DIE,DR,X,MHCD
- F MHCD=70,71,76,77,75,90,84 D
- . S DIC="^DIC(42.4,"_MHCD_",""E"","
- . S DA(1)=MHCD
- . S DIC(0)="LX"
- . S DIC("P")=$P(^DD(42.4,10,0),"^",2)
- . S X=3060701
- . D ^DIC
- . S DA=+Y
- . I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to MH code "_MHCD_" in the Specialty file.") Q
- . D BMES^XPDUTL(">>>Inactive date added to MH code "_MHCD_" in the Specialty file.<<<")
- . S DIE=DIC
- . S DR=".02///N"
- . D ^DIE
- . ;
- . ;check for MH CODES in the Facility Treating Specialty File (45.7
- . ;add inactivation date of 7/1/2006
- . ;
- . D BMES^XPDUTL(" ")
- . D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
- . D MES^XPDUTL(" pointing to "_MHCD_". If so, they will be inactivated.>>>")
- .N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",MHCD,DAA)) Q:'DAA D
- .. N DIE,DR,TS,X S TS=""
- ..S TS=$P($G(^DIC(45.7,DAA,0)),"^")
- ..S DIC="^DIC(45.7,"_DAA_",""E"","
- ..S DA(1)=DAA
- ..S DIC(0)="LX"
- ..S X=3060701
- ..D ^DIC
- ..S DA=+Y
- ..I +Y=-1 D BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.") Q
- ..D BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
- ..S DIE=DIC
- ..S DR=".02///N"
- ..D ^DIE
- Q
- EDIT ;Edit treating specialties
- ;
- N DS,DIE,DR,DGI
- S DIE="^DIC(42.4,"
- S DIC(0)="LX"
- F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT" D
- . S DGERR=0
- . S DA=$P(DGSPEC,U)
- . S DR=".01///"_$P(DGSPEC,U,2)_";1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7)
- . D ^DIE
- . D BMES^XPDUTL(" ")
- . D BMES^XPDUTL(" ")
- . D BMES^XPDUTL(">>>"_$P(DGSPEC,U)_" code updated to "_$P(DGSPEC,U,2)_" in the Specialty file.>>>")
- N DS,DIE,DR,DGI,DGII,DGSP,CNT,DGSPEC,DGSPEC1
- S DIE="^DIC(45.7,"
- S DIC(0)="LX"
- F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT" D
- . S DGERR=0
- . S DGSP=$P(DGSPEC,U)
- . S CNT=0,DGSPEC1=0 F DGII=0:0 S DGSPEC1=$O(^DIC(45.7,"ASPEC",DGSP,DGSPEC1)) Q:'DGSPEC1 S CNT=CNT+1 D
- .. I CNT=1 D
- ... I $$ACTIVE^DGACT(45.7,DGSPEC1)'=1 S CNT=0 Q
- ... S DA=DGSPEC1,DR=".01///"_$P(DGSPEC,U,2)_";99///@"
- ... D BMES^XPDUTL(" "_$P(^DIC(45.7,DGSPEC1,0),U)_" name has been changed to "_$P(DGSPEC,U,2)_" in the Facility Treating Specialty file.")
- ... D ^DIE
- .. E D
- ... S TS=""
- ... S TS=$P($G(^DIC(45.7,DGSPEC1,0)),"^")
- ... D BMES^XPDUTL(" Please review Facility Treating Specialty "_TS_". The entry name may need changing or entry may need inactivating since more than one entry points to "_$P(DGSPEC,U,2)_" in the Specialty file.<<<")
- Q
- TRSP ;PTF code^Speciality^Print Name^Service^Ask Psych^Billing Bedsection^CDR^^Ques#
- ;;64^NH SHORT STAY REHABILITATION^NH SS REHAB^NH^N^NURSING HOME CARE^1430^^
- ;;66^NH SHORT STAY RESTORATIVE^NH SS RESTOR^NH^N^NURSING HOME CARE^1430^^
- ;;67^NH SHORT STAY MAINTENANCE^NH SS MAINT^NH^N^NURSING HOME CARE^1430^^
- ;;68^NH SHORT STAY PSYCHIATRIC CARE^NH SS PSYCH^NH^N^NURSING HOME CARE^1430^^
- ;;69^NH SHORT STAY DEMENTIA CARE^NH SS DEMENTIA^NH^N^NURSING HOME CARE^1430^^
- ;;42^NH LONG STAY DEMENTIA CARE^NH LS DEMENTIA^NH^N^NURSING HOME CARE^1410^^
- ;;43^NH LONG STAY SKILLED NURSING^NH LS SKILL NUR^NH^N^NURSING HOME CARE^1410^^
- ;;44^NH LONG STAY MAINTENANCE CARE^NH LS MAINT^NH^N^NURSING HOME CARE^1410^^
- ;;45^NH LONG STAY PSYCHIATRIC CARE^NH LS PSYCH^NH^N^NURSING HOME CARE^1410^^
- ;;46^NH LONG STAY SPINAL CORD INJ^NH LS SPINAL^NH^N^NURSING HOME CARE^1410^^
- ;;47^NH RESPITE CARE (NHCU)^NH RC-NHCU^NH^N^^1430^^
- ;;QUIT
- ;
- ETRSP ;;PTF code^Speciality^Print Name^Service^Ask Psych^Billing Bedsection^CDR
- ;;83^RESPITE CARE (MEDICINE)^RC-MEDICINE^RESPITE CARE^N^^1110^^
- ;;95^NH SHORT STAY SKILLED NURSING^NH SS SKILL^NH^N^NURSING HOME CARE^1430^^
- ;;96^NH HOSPICE^NH HOSPICE^NH^N^NURSING HOME CARE^1425^^
- ;;81^NH GEM NURSING HOME CARE^NH GEM NHC^NH^N^NURSING HOME CARE^1420^^
- ;;QUIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53683P 7958 printed Mar 13, 2025@21:42:56 Page 2
- DG53683P ;ALB/DHH - Add NURSING HOME TREATING SPECIALTIES ; 11/01/05
- +1 ;;5.3;Registration;**683**;Nov 1, 2005
- +2 ;base program: DG53176P
- +3 ;
- EN ;Add Treating Specialties to the SPECIALITY file (#42.4)
- +1 NEW DGI,DGERR,DGSPEC,DGIFN,DGQUES
- +2 SET DGIFN=0
- +3 FOR DGI=1:1
- SET DGSPEC=$PIECE($TEXT(TRSP+DGI),";;",2)
- if DGSPEC="QUIT"
- QUIT
- Begin DoDot:1
- +4 DO TSPEC
- +5 SET DGQUES=$PIECE(DGSPEC,U,9)
- +6 DO FAC
- +7 QUIT
- End DoDot:1
- +8 DO EDIT
- +9 DO INACT80
- DO INACT
- +10 QUIT
- TSPEC ;Add treating specialty to SPECIALTY File (#42.4)
- +1 DO BMES^XPDUTL(">>>"_$PIECE(DGSPEC,U,2)_">>>")
- +2 NEW DA,DGFILE,DGMULT,DIC,DIE,DGDA1,DINUM,DLAYGO,DR,X,Y
- +3 SET DGERR=0
- +4 SET DIC="^DIC(42.4,"
- +5 SET DIC(0)="LX"
- +6 SET DINUM=$PIECE(DGSPEC,U)
- +7 SET X=$PIECE(DGSPEC,U,2)
- +8 SET DLAYGO=42.4
- +9 DO ^DIC
- +10 SET (DGIFN,DGDA1)=Y
- +11 IF +DGIFN=-1
- Begin DoDot:1
- +12 DO MES^XPDUTL(" Entry not added to SPECIALTY File (#42.4). No further updating will occur.")
- +13 DO MES^XPDUTL(" Please contact Customer Service for assistance.")
- +14 QUIT
- End DoDot:1
- QUIT
- +15 IF $PIECE(DGIFN,U,3)'=1&(+DGIFN'=$PIECE(DGSPEC,U))
- Begin DoDot:1
- +16 DO MES^XPDUTL(" Entry exists in SPECIALTY File (#42.4), but with a different PTF Code #.")
- +17 DO MES^XPDUTL(" No further updating will occur. Please review entry.")
- +18 SET DGERR=1
- +19 QUIT
- End DoDot:1
- QUIT
- +20 DO MES^XPDUTL(" Entry "_$SELECT($PIECE(DGIFN,U,3)=1:"added to",1:"exists in")_" SPECIALTY File (#42.4).")
- +21 DO MES^XPDUTL(" Updating SPECIALTY File fields.")
- +22 SET DIE=DIC
- +23 SET DR="1///"_$PIECE(DGSPEC,U,3)_";3///"_$PIECE(DGSPEC,U,4)_";4///"_$PIECE(DGSPEC,U,5)_";5///"_$PIECE(DGSPEC,U,6)_";6///"_$PIECE(DGSPEC,U,7)
- +24 SET DA=+DGIFN
- +25 DO ^DIE
- +26 SET DGFILE=42.4
- +27 SET DGMULT=10
- +28 SET DIC="^DIC(42.4,"_+DGIFN_",""E"","
- +29 DO MULT
- +30 QUIT
- FAC ;Add treating specialty to Facility Treating Specialty file (#45.7)
- +1 NEW DA,DGFILE,DGMULT,DIC,DIE,DLAYGO,DR,X,Y
- +2 SET DIC="^DIC(45.7,"
- +3 SET DIC(0)="LXZ"
- +4 SET DLAYGO=45.7
- +5 SET X=$PIECE(DGSPEC,U,2)
- +6 DO ^DIC
- +7 SET DGDA1=Y
- +8 IF +DGDA1=-1
- DO BMES^XPDUTL(" Entry not added to FACILITY TREATING SPECIALTY File(#45.7).")
- QUIT
- +9 IF $PIECE(DGDA1,U,3)'=1&($PIECE(Y(0),U,2)'=$PIECE(DGSPEC,U))
- Begin DoDot:1
- +10 DO BMES^XPDUTL(" Entry exists in FACILITY TREATING SPECIALTY File (#45.7), but with")
- +11 DO MES^XPDUTL(" a different PTF Code #. No further updating will occur.")
- +12 DO MES^XPDUTL(" Please review entry.")
- +13 QUIT
- End DoDot:1
- QUIT
- +14 DO BMES^XPDUTL(" Entry "_$SELECT($PIECE(DGDA1,U,3)=1:"added to",1:"exists in")_" FACILITY TREATING SPECIALTY File (#45.7).")
- +15 DO MES^XPDUTL(" Updating SPECIALTY field...")
- +16 SET DIE=DIC
- +17 SET DA=+DGDA1
- +18 SET DR="1////"_$PIECE(DGSPEC,U)
- +19 DO ^DIE
- +20 SET DGFILE=45.7
- +21 SET DGMULT=100
- +22 SET DIC="^DIC(45.7,"_+DGDA1_",""E"","
- +23 DO MULT
- +24 QUIT
- MULT ;Add Effective Date
- +1 NEW DA,DIE,DR
- +2 SET DA(1)=+DGDA1
- +3 SET DIC(0)="LX"
- +4 SET DIC("P")=$PIECE(^DD(DGFILE,DGMULT,0),"^",2)
- +5 SET X=3060701
- +6 DO ^DIC
- +7 SET DA=+Y
- +8 IF +Y=-1
- DO MES^XPDUTL(" Effective date not added.")
- QUIT
- +9 DO MES^XPDUTL(" Effective date added.")
- +10 SET DIE=DIC
- +11 SET DR=".02///Y"
- +12 DO ^DIE
- +13 QUIT
- INACT80 ;inactivate code 80
- +1 NEW DA,DIE,DR,X
- +2 SET DIC="^DIC(42.4,80,""E"","
- +3 SET DA(1)=80
- +4 SET DIC(0)="LX"
- +5 SET DIC("P")=$PIECE(^DD(42.4,10,0),"^",2)
- +6 SET X=3060802
- +7 DO ^DIC
- +8 SET DA=+Y
- +9 DO BMES^XPDUTL(" ")
- +10 DO BMES^XPDUTL(" ")
- +11 DO BMES^XPDUTL(" ")
- +12 IF +Y=-1
- DO BMES^XPDUTL(">>>Inactive date not added to 80-NHCU in the Specialty file.")
- QUIT
- +13 DO BMES^XPDUTL(">>>Inactive date added to 80-NHCU in the Specialty file.<<<")
- +14 SET DIE=DIC
- +15 SET DR=".02///N"
- +16 DO ^DIE
- +17 ;
- +18 ; -- check for NHCU 80 in the Facility Treating Specialty File (45.7
- +19 ; add inactivation date of 8/2/2006
- +20 ;
- +21 DO BMES^XPDUTL(" ")
- +22 DO MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
- +23 DO MES^XPDUTL(" pointing to 80-NHCU. If so, they will be inactivated.>>>")
- +24 NEW DAA
- FOR DAA=0:0
- SET DAA=$ORDER(^DIC(45.7,"ASPEC",80,DAA))
- if 'DAA
- QUIT
- Begin DoDot:1
- +25 NEW DIE,DR,TS,X
- SET TS=""
- +26 SET TS=$PIECE($GET(^DIC(45.7,DAA,0)),"^")
- +27 SET DIC="^DIC(45.7,"_DAA_",""E"","
- +28 SET DA(1)=DAA
- +29 SET DIC(0)="LX"
- +30 SET X=3060802
- +31 DO ^DIC
- +32 SET DA=+Y
- +33 IF +Y=-1
- DO BMES^XPDUTL(" Inactive date not added to "_TS_" in the Facility Treating Specialty file.")
- QUIT
- +34 DO BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.")
- +35 SET DIE=DIC
- +36 SET DR=".02///N"
- +37 DO ^DIE
- End DoDot:1
- +38 QUIT
- INACT ;inactivate mental health codes
- +1 NEW DA,DIE,DR,X,MHCD
- +2 FOR MHCD=70,71,76,77,75,90,84
- Begin DoDot:1
- +3 SET DIC="^DIC(42.4,"_MHCD_",""E"","
- +4 SET DA(1)=MHCD
- +5 SET DIC(0)="LX"
- +6 SET DIC("P")=$PIECE(^DD(42.4,10,0),"^",2)
- +7 SET X=3060701
- +8 DO ^DIC
- +9 SET DA=+Y
- +10 IF +Y=-1
- DO BMES^XPDUTL(">>>Inactive date not added to MH code "_MHCD_" in the Specialty file.")
- QUIT
- +11 DO BMES^XPDUTL(">>>Inactive date added to MH code "_MHCD_" in the Specialty file.<<<")
- +12 SET DIE=DIC
- +13 SET DR=".02///N"
- +14 DO ^DIE
- +15 ;
- +16 ;check for MH CODES in the Facility Treating Specialty File (45.7
- +17 ;add inactivation date of 7/1/2006
- +18 ;
- +19 DO BMES^XPDUTL(" ")
- +20 DO MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
- +21 DO MES^XPDUTL(" pointing to "_MHCD_". If so, they will be inactivated.>>>")
- +22 NEW DAA
- FOR DAA=0:0
- SET DAA=$ORDER(^DIC(45.7,"ASPEC",MHCD,DAA))
- if 'DAA
- QUIT
- Begin DoDot:2
- +23 NEW DIE,DR,TS,X
- SET TS=""
- +24 SET TS=$PIECE($GET(^DIC(45.7,DAA,0)),"^")
- +25 SET DIC="^DIC(45.7,"_DAA_",""E"","
- +26 SET DA(1)=DAA
- +27 SET DIC(0)="LX"
- +28 SET X=3060701
- +29 DO ^DIC
- +30 SET DA=+Y
- +31 IF +Y=-1
- DO BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.")
- QUIT
- +32 DO BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
- +33 SET DIE=DIC
- +34 SET DR=".02///N"
- +35 DO ^DIE
- End DoDot:2
- End DoDot:1
- +36 QUIT
- EDIT ;Edit treating specialties
- +1 ;
- +2 NEW DS,DIE,DR,DGI
- +3 SET DIE="^DIC(42.4,"
- +4 SET DIC(0)="LX"
- +5 FOR DGI=1:1
- SET DGSPEC=$PIECE($TEXT(ETRSP+DGI),";;",2)
- if DGSPEC="QUIT"
- QUIT
- Begin DoDot:1
- +6 SET DGERR=0
- +7 SET DA=$PIECE(DGSPEC,U)
- +8 SET DR=".01///"_$PIECE(DGSPEC,U,2)_";1///"_$PIECE(DGSPEC,U,3)_";3///"_$PIECE(DGSPEC,U,4)_";4///"_$PIECE(DGSPEC,U,5)_";5///"_$PIECE(DGSPEC,U,6)_";6///"_$PIECE(DGSPEC,U,7)
- +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 Specialty file.>>>")
- End DoDot:1
- +13 NEW DS,DIE,DR,DGI,DGII,DGSP,CNT,DGSPEC,DGSPEC1
- +14 SET DIE="^DIC(45.7,"
- +15 SET DIC(0)="LX"
- +16 FOR DGI=1:1
- SET DGSPEC=$PIECE($TEXT(ETRSP+DGI),";;",2)
- if DGSPEC="QUIT"
- QUIT
- Begin DoDot:1
- +17 SET DGERR=0
- +18 SET DGSP=$PIECE(DGSPEC,U)
- +19 SET CNT=0
- SET DGSPEC1=0
- FOR DGII=0:0
- SET DGSPEC1=$ORDER(^DIC(45.7,"ASPEC",DGSP,DGSPEC1))
- if 'DGSPEC1
- QUIT
- SET CNT=CNT+1
- Begin DoDot:2
- +20 IF CNT=1
- Begin DoDot:3
- +21 IF $$ACTIVE^DGACT(45.7,DGSPEC1)'=1
- SET CNT=0
- QUIT
- +22 SET DA=DGSPEC1
- SET DR=".01///"_$PIECE(DGSPEC,U,2)_";99///@"
- +23 DO BMES^XPDUTL(" "_$PIECE(^DIC(45.7,DGSPEC1,0),U)_" name has been changed to "_$PIECE(DGSPEC,U,2)_" in the Facility Treating Specialty file.")
- +24 DO ^DIE
- End DoDot:3
- +25 IF '$TEST
- Begin DoDot:3
- +26 SET TS=""
- +27 SET TS=$PIECE($GET(^DIC(45.7,DGSPEC1,0)),"^")
- +28 DO BMES^XPDUTL(" Please review Facility Treating Specialty "_TS_". The entry name may need changing or entry may need inactivating since more than one entry points to "_$PIECE(DGSPEC,U,2)_" in the Specialty file.<<<
- ")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 QUIT
- TRSP ;PTF code^Speciality^Print Name^Service^Ask Psych^Billing Bedsection^CDR^^Ques#
- +1 ;;64^NH SHORT STAY REHABILITATION^NH SS REHAB^NH^N^NURSING HOME CARE^1430^^
- +2 ;;66^NH SHORT STAY RESTORATIVE^NH SS RESTOR^NH^N^NURSING HOME CARE^1430^^
- +3 ;;67^NH SHORT STAY MAINTENANCE^NH SS MAINT^NH^N^NURSING HOME CARE^1430^^
- +4 ;;68^NH SHORT STAY PSYCHIATRIC CARE^NH SS PSYCH^NH^N^NURSING HOME CARE^1430^^
- +5 ;;69^NH SHORT STAY DEMENTIA CARE^NH SS DEMENTIA^NH^N^NURSING HOME CARE^1430^^
- +6 ;;42^NH LONG STAY DEMENTIA CARE^NH LS DEMENTIA^NH^N^NURSING HOME CARE^1410^^
- +7 ;;43^NH LONG STAY SKILLED NURSING^NH LS SKILL NUR^NH^N^NURSING HOME CARE^1410^^
- +8 ;;44^NH LONG STAY MAINTENANCE CARE^NH LS MAINT^NH^N^NURSING HOME CARE^1410^^
- +9 ;;45^NH LONG STAY PSYCHIATRIC CARE^NH LS PSYCH^NH^N^NURSING HOME CARE^1410^^
- +10 ;;46^NH LONG STAY SPINAL CORD INJ^NH LS SPINAL^NH^N^NURSING HOME CARE^1410^^
- +11 ;;47^NH RESPITE CARE (NHCU)^NH RC-NHCU^NH^N^^1430^^
- +12 ;;QUIT
- +13 ;
- ETRSP ;;PTF code^Speciality^Print Name^Service^Ask Psych^Billing Bedsection^CDR
- +1 ;;83^RESPITE CARE (MEDICINE)^RC-MEDICINE^RESPITE CARE^N^^1110^^
- +2 ;;95^NH SHORT STAY SKILLED NURSING^NH SS SKILL^NH^N^NURSING HOME CARE^1430^^
- +3 ;;96^NH HOSPICE^NH HOSPICE^NH^N^NURSING HOME CARE^1425^^
- +4 ;;81^NH GEM NURSING HOME CARE^NH GEM NHC^NH^N^NURSING HOME CARE^1420^^
- +5 ;;QUIT
- +6 QUIT
