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 Dec 13, 2024@02:35:15 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
