- DG1074P ;MNTVBB/RS - TREATING SPECIALTIES UPDATE ; 1/12/2022 11:10am
- ;;5.3;Registration;**1074**;Aug 13, 1993;Build 4
- ;
- Q
- EN ;Add Treating Specialties to the SPECIALTY file (#42.4)
- N DGI,DGERR,DGSPEC,DGIFN,DGQUES
- S DGIFN=0
- ;add new treating specialties
- 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
- 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 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)=DGSPEC
- 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
- D MES^XPDUTL(" Entry added to SPECIALTY File (#42.4).")
- D MES^XPDUTL(" Updating SPECIALTY File fields.")
- S DIE=DIC
- 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)_";7///"_$P(DGSPEC,U,10)
- 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=3221001
- 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
- TRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR^^QUES#^AUSTIN PTF CODE
- ;;113^SPINAL CORD INJURY LTC CENTER^SCI LTC CENTER^SPINAL CORD INJURY^N^SPINAL CORD INJURY CARE^1116^^^1O
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1074P 2697 printed Feb 19, 2025@00:01:17 Page 2
- DG1074P ;MNTVBB/RS - TREATING SPECIALTIES UPDATE ; 1/12/2022 11:10am
- +1 ;;5.3;Registration;**1074**;Aug 13, 1993;Build 4
- +2 ;
- +3 QUIT
- EN ;Add Treating Specialties to the SPECIALTY file (#42.4)
- +1 NEW DGI,DGERR,DGSPEC,DGIFN,DGQUES
- +2 SET DGIFN=0
- +3 ;add new treating specialties
- +4 FOR DGI=1:1
- SET DGSPEC=$PIECE($TEXT(TRSP+DGI),";;",2)
- if DGSPEC="QUIT"
- QUIT
- Begin DoDot:1
- +5 DO TSPEC
- +6 SET DGQUES=$PIECE(DGSPEC,U,9)
- +7 DO FAC
- +8 QUIT
- End DoDot:1
- +9 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 DIC="^DIC(42.4,"
- +4 SET DIC(0)="LX"
- +5 SET DINUM=$PIECE(DGSPEC,U)
- +6 SET X=$PIECE(DGSPEC,U,2)
- +7 SET DLAYGO=42.4
- +8 DO ^DIC
- +9 SET (DGIFN,DGDA1)=DGSPEC
- +10 IF +DGIFN=-1
- Begin DoDot:1
- +11 DO MES^XPDUTL(" Entry not added to SPECIALTY File (#42.4). No further updating will occur.")
- +12 DO MES^XPDUTL(" Please contact Customer Service for assistance.")
- +13 QUIT
- End DoDot:1
- QUIT
- +14 DO MES^XPDUTL(" Entry added to SPECIALTY File (#42.4).")
- +15 DO MES^XPDUTL(" Updating SPECIALTY File fields.")
- +16 SET DIE=DIC
- +17 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)_";7///"_$PIECE(DGSPEC,U,10)
- +18 SET DA=+DGIFN
- +19 DO ^DIE
- +20 SET DGFILE=42.4
- +21 SET DGMULT=10
- +22 SET DIC="^DIC(42.4,"_+DGIFN_",""E"","
- +23 DO MULT
- +24 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=3221001
- +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
- TRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR^^QUES#^AUSTIN PTF CODE
- +1 ;;113^SPINAL CORD INJURY LTC CENTER^SCI LTC CENTER^SPINAL CORD INJURY^N^SPINAL CORD INJURY CARE^1116^^^1O
- +2 ;;QUIT