DG53P844 ;ALB/MJB/RC - TREATING SPECIALTIES UPDATES ; 6/22/11 3:45pm
;;5.3;Registration;**844**;Aug 13, 1993;Build 3
;
Q
;; This routine is used to add, edit and inactivate Specialties in the specialty file and
;; edit existing surgical specialties.
;;
EN ; Changes to the SPECIALITY file (#42.4)
N DGI,DGERR,DGSPEC,DGIFN,DGQUES
;edit existing treating specialties, if needed
D EDIT
;inactivate existing treating specialties, if needed
D INACT
;edit existing surgical specialties, if needed
;D EDIT^DG53813R
Q
INACT ;inactivate treating specialties
N DA,DIE,DR,X,DGTSP,DIC,Y
F DGTSP=43 D
. S DIC="^DIC(42.4,"_DGTSP_",""E"","
. S DA(1)=DGTSP
. S DIC(0)="LX"
. S DIC("P")=$P(^DD(42.4,10,0),"^",2)
. S X=3111001
. D ^DIC
. S DA=+Y
. I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to TS code "_DGTSP_" in the Specialty file.<<<") Q
. D BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" in the Specialty file.<<<")
. S DIE=DIC
. S DR=".02///N"
. D ^DIE
. ;check for CODES in the Facility Treating Specialty File (45.7
. ;add inactivation date of 10/1/2011
. D BMES^XPDUTL(" ")
. D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
. D MES^XPDUTL(" pointing to "_DGTSP_". If so, they will be inactivated.>>>")
.N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",DGTSP,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=3111001
..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,DIC,Y
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
ETRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR
;;67^NH SHORT-STAY CONTINUING CARE^NH SS CONT CARE^NHCU^NO^NURSING HOME CARE^1430^^
;;68^NH SHORT-STAY MH RECOVERY^NH SS MH RECVRY^NHCU^NO^NURSING HOME CARE^1430^^
;;44^NH LONG-STAY CONTINUING CARE^NH LS CONT CARE^NHCU^NO^NURSING HOME CARE^1410^^
;;45^NH LONG-STAY MH RECOVERY^NH LS MH RECVRY^NHCU^NO^NURSING HOME CARE^1410^^
;;QUIT
PTFCHK ;Check Open PTF records for TS 43
N DGPTFIEN,DGMVTIEN,DGTEXTLN,DGTEXT,DGSPCS
S DGPTFIEN="",DGTEXTLN=10,DGSPCS=" "
;Go through Open PTF records
F S DGPTFIEN=$O(^DGPT("AS",0,DGPTFIEN)) Q:'DGPTFIEN D
.;Find the newest movement
.S DGMVTIEN=9999999
.S DGMVTIEN=$O(^DGPT(DGPTFIEN,"M",DGMVTIEN),-1)
.;If the treating specialty is 43 add to the mail message
.I DGMVTIEN,$P($G(^DGPT(DGPTFIEN,"M",DGMVTIEN,0)),U,2)=43 D
..N DGPTNM,DGPTAD
..;retrieve the patient's name and admission date
..D GETS^DIQ(45,DGPTFIEN_",",".01;2","EI","DGPTINFO")
..S DGPTNM=$E(DGPTINFO(45,DGPTFIEN_",",".01","E")_DGSPCS,1,30)
..S DGPTAD=DGPTINFO(45,DGPTFIEN_",","2","E")
..S DGTEXTLN=DGTEXTLN+1
..;add a new line to the mail message in the format
..;ptf record #, patient's name, admission date
..S DGTEXT(DGTEXTLN)=$E(DGPTFIEN_DGSPCS,1,10)_" "_DGPTNM_" "_DGPTAD
..K DGPTINFO,DGPTNM,DGPTAD
D GENMAIL(DGTEXTLN,.DGTEXT)
Q
GENMAIL(DGTEXTLN,DGTEXT) ;Generate mail message with PTF information
N XMDUZ,XMSUB,XMY,XMTEXT,DIFROM ;Mailman Variables
S XMDUZ=".5" ;Message originates from postmaster
S XMY(DUZ)="" ;Send message to patch installer
S XMSUB="Treating Specialty Update DG*5.3*844"
S XMTEXT="DGTEXT("
S DGTEXT(1)="This message was generated by the installation of DG*5.3*844."
I DGTEXTLN=10 D Q
.S DGTEXT(2)="There are no patients requiring treating specialty updates."
.S DGTEXT(3)="No action is required."
.D ^XMD
S DGTEXT(2)="There are patients at your site that are still assigned to treating specialty: "
S DGTEXT(3)="43 NH LONG STAY SKILLED NURING."
S DGTEXT(4)="This code is inactive as of October 1, 2011."
S DGTEXT(5)="Please forward this message to the appropriate MAS personnel for review."
S DGTEXT(6)=""
S DGTEXT(7)="Patients requiring treating specialty updates:"
S DGTEXT(8)=""
S DGTEXT(9)="PTF# PATIENT ADMISSION DATE"
S DGTEXT(10)="------------------------------------------------------------------"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P844 5683 printed Apr 09, 2024@21:59:19 Page 2
DG53P844 ;ALB/MJB/RC - TREATING SPECIALTIES UPDATES ; 6/22/11 3:45pm
+1 ;;5.3;Registration;**844**;Aug 13, 1993;Build 3
+2 ;
+3 QUIT
+4 ;; This routine is used to add, edit and inactivate Specialties in the specialty file and
+5 ;; edit existing surgical specialties.
+6 ;;
EN ; Changes to the SPECIALITY file (#42.4)
+1 NEW DGI,DGERR,DGSPEC,DGIFN,DGQUES
+2 ;edit existing treating specialties, if needed
+3 DO EDIT
+4 ;inactivate existing treating specialties, if needed
+5 DO INACT
+6 ;edit existing surgical specialties, if needed
+7 ;D EDIT^DG53813R
+8 QUIT
INACT ;inactivate treating specialties
+1 NEW DA,DIE,DR,X,DGTSP,DIC,Y
+2 FOR DGTSP=43
Begin DoDot:1
+3 SET DIC="^DIC(42.4,"_DGTSP_",""E"","
+4 SET DA(1)=DGTSP
+5 SET DIC(0)="LX"
+6 SET DIC("P")=$PIECE(^DD(42.4,10,0),"^",2)
+7 SET X=3111001
+8 DO ^DIC
+9 SET DA=+Y
+10 IF +Y=-1
DO BMES^XPDUTL(">>>Inactive date not added to TS code "_DGTSP_" in the Specialty file.<<<")
QUIT
+11 DO BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" in the Specialty file.<<<")
+12 SET DIE=DIC
+13 SET DR=".02///N"
+14 DO ^DIE
+15 ;check for CODES in the Facility Treating Specialty File (45.7
+16 ;add inactivation date of 10/1/2011
+17 DO BMES^XPDUTL(" ")
+18 DO MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
+19 DO MES^XPDUTL(" pointing to "_DGTSP_". If so, they will be inactivated.>>>")
+20 NEW DAA
FOR DAA=0:0
SET DAA=$ORDER(^DIC(45.7,"ASPEC",DGTSP,DAA))
if 'DAA
QUIT
Begin DoDot:2
+21 NEW DIE,DR,TS,X
SET TS=""
+22 SET TS=$PIECE($GET(^DIC(45.7,DAA,0)),"^")
+23 SET DIC="^DIC(45.7,"_DAA_",""E"","
+24 SET DA(1)=DAA
+25 SET DIC(0)="LX"
+26 SET X=3111001
+27 DO ^DIC
+28 SET DA=+Y
+29 IF +Y=-1
DO BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.")
QUIT
+30 DO BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
+31 SET DIE=DIC
+32 SET DR=".02///N"
+33 DO ^DIE
End DoDot:2
End DoDot:1
+34 QUIT
EDIT ;Edit treating specialties
+1 ;
+2 NEW DS,DIE,DR,DGI,DIC,Y
+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
ETRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR
+1 ;;67^NH SHORT-STAY CONTINUING CARE^NH SS CONT CARE^NHCU^NO^NURSING HOME CARE^1430^^
+2 ;;68^NH SHORT-STAY MH RECOVERY^NH SS MH RECVRY^NHCU^NO^NURSING HOME CARE^1430^^
+3 ;;44^NH LONG-STAY CONTINUING CARE^NH LS CONT CARE^NHCU^NO^NURSING HOME CARE^1410^^
+4 ;;45^NH LONG-STAY MH RECOVERY^NH LS MH RECVRY^NHCU^NO^NURSING HOME CARE^1410^^
+5 ;;QUIT
PTFCHK ;Check Open PTF records for TS 43
+1 NEW DGPTFIEN,DGMVTIEN,DGTEXTLN,DGTEXT,DGSPCS
+2 SET DGPTFIEN=""
SET DGTEXTLN=10
SET DGSPCS=" "
+3 ;Go through Open PTF records
+4 FOR
SET DGPTFIEN=$ORDER(^DGPT("AS",0,DGPTFIEN))
if 'DGPTFIEN
QUIT
Begin DoDot:1
+5 ;Find the newest movement
+6 SET DGMVTIEN=9999999
+7 SET DGMVTIEN=$ORDER(^DGPT(DGPTFIEN,"M",DGMVTIEN),-1)
+8 ;If the treating specialty is 43 add to the mail message
+9 IF DGMVTIEN
IF $PIECE($GET(^DGPT(DGPTFIEN,"M",DGMVTIEN,0)),U,2)=43
Begin DoDot:2
+10 NEW DGPTNM,DGPTAD
+11 ;retrieve the patient's name and admission date
+12 DO GETS^DIQ(45,DGPTFIEN_",",".01;2","EI","DGPTINFO")
+13 SET DGPTNM=$EXTRACT(DGPTINFO(45,DGPTFIEN_",",".01","E")_DGSPCS,1,30)
+14 SET DGPTAD=DGPTINFO(45,DGPTFIEN_",","2","E")
+15 SET DGTEXTLN=DGTEXTLN+1
+16 ;add a new line to the mail message in the format
+17 ;ptf record #, patient's name, admission date
+18 SET DGTEXT(DGTEXTLN)=$EXTRACT(DGPTFIEN_DGSPCS,1,10)_" "_DGPTNM_" "_DGPTAD
+19 KILL DGPTINFO,DGPTNM,DGPTAD
End DoDot:2
End DoDot:1
+20 DO GENMAIL(DGTEXTLN,.DGTEXT)
+21 QUIT
GENMAIL(DGTEXTLN,DGTEXT) ;Generate mail message with PTF information
+1 ;Mailman Variables
NEW XMDUZ,XMSUB,XMY,XMTEXT,DIFROM
+2 ;Message originates from postmaster
SET XMDUZ=".5"
+3 ;Send message to patch installer
SET XMY(DUZ)=""
+4 SET XMSUB="Treating Specialty Update DG*5.3*844"
+5 SET XMTEXT="DGTEXT("
+6 SET DGTEXT(1)="This message was generated by the installation of DG*5.3*844."
+7 IF DGTEXTLN=10
Begin DoDot:1
+8 SET DGTEXT(2)="There are no patients requiring treating specialty updates."
+9 SET DGTEXT(3)="No action is required."
+10 DO ^XMD
End DoDot:1
QUIT
+11 SET DGTEXT(2)="There are patients at your site that are still assigned to treating specialty: "
+12 SET DGTEXT(3)="43 NH LONG STAY SKILLED NURING."
+13 SET DGTEXT(4)="This code is inactive as of October 1, 2011."
+14 SET DGTEXT(5)="Please forward this message to the appropriate MAS personnel for review."
+15 SET DGTEXT(6)=""
+16 SET DGTEXT(7)="Patients requiring treating specialty updates:"
+17 SET DGTEXT(8)=""
+18 SET DGTEXT(9)="PTF# PATIENT ADMISSION DATE"
+19 SET DGTEXT(10)="------------------------------------------------------------------"
+20 DO ^XMD
+21 QUIT
