- SD5USTOP ;ALB/CAW,GTS,ESD,JAM,GT - Stop Code/DSS Identifier Update 2/10/2005
- ;;5.3;Scheduling;**428**;AUG 13, 1993
- ;
- ;** This patch is used as a Post-Init in a KIDS build to modify the
- ;** the DSS Identifier file [^DIC(40.7,]
- ;
- EN ;** Add/inactivate/change/reactivate DSS IDs (stop codes)
- ;** The following code executes if file modifications exist
- ;
- N SDVAR
- D:$P($T(NEW+1),";;",2)'="QUIT" ADD
- D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
- Q
- ;
- ;
- ADD ;** Add DSS IDs
- ;
- ; SDXX is in format:
- ; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
- ;
- N SDX,SDXX
- S SDVAR=1
- D MES^XPDUTL("")
- D BMES^XPDUTL(">>> Adding new Clinic Stops (DSS IDs) to CLINIC STOP File (#40.7)...")
- ;
- ;** NOTE: The following line is for DSS IDs that are not yet active
- D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 2/1/05]")
- S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(NEW+SDX),";;",2) Q:SDXX="QUIT" DO
- .S DIC("DR")="1////"_$P(SDXX,"^",2)_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))
- .S DIC("DR")=DIC("DR")_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
- .S X=$P(SDXX,"^",1)
- .I '$D(^DIC(40.7,"C",$P(SDXX,"^",2))) D FILE^DICN,MESS Q
- .;I $D(^DIC(40.7,"C",$P(SDXX,"^",2))) D EDIT(SDXX),MESSEX
- K DIC,DLAYGO,X
- Q
- ;
- EDIT(SDXX) ;- Edit fields w/new values if stop code record already exists
- ;
- Q:$G(SDXX)=""
- N DA,DIE,DLAYGO,DR
- S DA=+$O(^DIC(40.7,"C",+$P(SDXX,"^",2),0))
- Q:'DA
- S DIE="^DIC(40.7,",DR=".01////"_$P(SDXX,"^")_";1////"_$P(SDXX,"^",2)_";2////@"_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
- D ^DIE
- Q
- ;
- CHANGE ;** Change DSS ID names
- ;
- ; SDXX is in format:
- ; STOP CODE NAME^AMIS #^^NEW STOP CODE NAME
- ;
- N SDX,SDXX,SDDA
- S SDVAR=1
- D MES^XPDUTL("")
- D BMES^XPDUTL(">>> Changing Clinic Stop (DSS ID) names in CLINIC STOP File (#40.7)...")
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CHNG+SDX),";;",2) Q:SDXX="QUIT" DO
- .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
- .I $D(^DIC(40.7,SDDA,0)) DO
- ..S DA=SDDA,DR=".01///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
- ..D ^DIE,MESC
- K DIE,DR,DA
- Q
- ;
- MESS ;** Add message
- N ECXADMSG
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- S ECXADMSG="Added: "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")
- I $P(SDXX,"^",5)'="" S ECXADMSG=ECXADMSG_" [CDR#: "_$P(SDXX,"^",5)_"]"
- D MES^XPDUTL(ECXADMSG)
- I $P(SDXX,"^",3)'="" S ECXADMSG=" Restricted Type: "_$P(SDXX,"^",3)_" Restricted Date: "_$P(SDXX,"^",4)
- D MES^XPDUTL(ECXADMSG)
- K SDVAR
- Q
- ;
- MESSEX ;** Display message if stop code already exists
- N ECXADMSG
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- S ECXADMSG=" "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")_" already exists."
- D MES^XPDUTL(ECXADMSG)
- K SDVAR
- Q
- ;
- MESC ;** Change message
- N SDCMSG,SDCMSG1
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- S SDCMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
- S SDCMSG1=" to: "_$P(SDXX,U,2)_" "_$P(SDXX,U,4)
- D MES^XPDUTL(SDCMSG)
- D MES^XPDUTL(SDCMSG1)
- K SDVAR
- Q
- ;
- HDR(SDVAR) ;- Header
- Q:'$G(SDVAR)
- N SDHDR
- S SDHDR=$P($T(@("HDR"_SDVAR)),";;",2)
- D BMES^XPDUTL(SDHDR)
- Q
- ;
- ;
- HDR1 ;; Stop Code Name
- ;
- HDR2 ;; CDR Stop Code Name
- ;
- HDR3 ;; Stop Code Name Rest. Type Date
- ;
- NEW ;DSS IDs to add- ex ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
- ;;QUIT
- ;
- CHNG ;DSS ID name changes- example ;;STOP CODE NAME^NUMBER^^NEW NAME
- ;;PMRS CWT/SE NON-F TO F (MASNONCT)^223^^PMRS CWT/SE NON-F TO F (MAS NO
- ;;PMRS CWT/TWE NON-F TO F (MASNONCT)^228^^PMRS CWT/TWE NON-F TO F (MAS N
- ;;VISOR (VISUAL IMPAIRMENT OUTPATIENT PROGRAM)^220^^VISOR (VISL IMPRMT OUTPAT PGM)
- ;;MH CWT/SE NON-F TO F (MAS NONCT^569^^MH CWT/SE NON-F TO F (MAS NONC
- ;;MH CWT/TWE NON-F TO F (MAS NONCT^570^^MH CWT/TWE NON-F TO F (MAS NON
- ;;NONVIDEO HOME TELEHEALTH INTERVENTION^684^^NONVIDEO HOME TELEHLTH INTRVNT
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5USTOP 4072 printed Jan 18, 2025@03:47:58 Page 2
- SD5USTOP ;ALB/CAW,GTS,ESD,JAM,GT - Stop Code/DSS Identifier Update 2/10/2005
- +1 ;;5.3;Scheduling;**428**;AUG 13, 1993
- +2 ;
- +3 ;** This patch is used as a Post-Init in a KIDS build to modify the
- +4 ;** the DSS Identifier file [^DIC(40.7,]
- +5 ;
- EN ;** Add/inactivate/change/reactivate DSS IDs (stop codes)
- +1 ;** The following code executes if file modifications exist
- +2 ;
- +3 NEW SDVAR
- +4 if $PIECE($TEXT(NEW+1),";;",2)'="QUIT"
- DO ADD
- +5 if $PIECE($TEXT(CHNG+1),";;",2)'="QUIT"
- DO CHANGE
- +6 QUIT
- +7 ;
- +8 ;
- ADD ;** Add DSS IDs
- +1 ;
- +2 ; SDXX is in format:
- +3 ; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
- +4 ;
- +5 NEW SDX,SDXX
- +6 SET SDVAR=1
- +7 DO MES^XPDUTL("")
- +8 DO BMES^XPDUTL(">>> Adding new Clinic Stops (DSS IDs) to CLINIC STOP File (#40.7)...")
- +9 ;
- +10 ;** NOTE: The following line is for DSS IDs that are not yet active
- +11 DO BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 2/1/05]")
- +12 SET DIC(0)="L"
- SET DLAYGO=40.7
- SET DIC="^DIC(40.7,"
- +13 FOR SDX=1:1
- KILL DD,DO,DA
- SET SDXX=$PIECE($TEXT(NEW+SDX),";;",2)
- if SDXX="QUIT"
- QUIT
- Begin DoDot:1
- +14 SET DIC("DR")="1////"_$PIECE(SDXX,"^",2)_$SELECT('+$PIECE(SDXX,U,5):"",1:";4////"_$PIECE(SDXX,"^",5))
- +15 SET DIC("DR")=DIC("DR")_";5////"_$PIECE(SDXX,"^",3)_";6///"_$PIECE(SDXX,"^",4)
- +16 SET X=$PIECE(SDXX,"^",1)
- +17 IF '$DATA(^DIC(40.7,"C",$PIECE(SDXX,"^",2)))
- DO FILE^DICN
- DO MESS
- QUIT
- +18 ;I $D(^DIC(40.7,"C",$P(SDXX,"^",2))) D EDIT(SDXX),MESSEX
- End DoDot:1
- +19 KILL DIC,DLAYGO,X
- +20 QUIT
- +21 ;
- EDIT(SDXX) ;- Edit fields w/new values if stop code record already exists
- +1 ;
- +2 if $GET(SDXX)=""
- QUIT
- +3 NEW DA,DIE,DLAYGO,DR
- +4 SET DA=+$ORDER(^DIC(40.7,"C",+$PIECE(SDXX,"^",2),0))
- +5 if 'DA
- QUIT
- +6 SET DIE="^DIC(40.7,"
- SET DR=".01////"_$PIECE(SDXX,"^")_";1////"_$PIECE(SDXX,"^",2)_";2////@"_$SELECT('+$PIECE(SDXX,U,5):"",1:";4////"_$PIECE(SDXX,"^",5))_";5////"_$PIECE(SDXX,"^",3)_";6///"_$PIECE(SDXX,"^",4)
- +7 DO ^DIE
- +8 QUIT
- +9 ;
- CHANGE ;** Change DSS ID names
- +1 ;
- +2 ; SDXX is in format:
- +3 ; STOP CODE NAME^AMIS #^^NEW STOP CODE NAME
- +4 ;
- +5 NEW SDX,SDXX,SDDA
- +6 SET SDVAR=1
- +7 DO MES^XPDUTL("")
- +8 DO BMES^XPDUTL(">>> Changing Clinic Stop (DSS ID) names in CLINIC STOP File (#40.7)...")
- +9 FOR SDX=1:1
- KILL DD,DO,DA
- SET SDXX=$PIECE($TEXT(CHNG+SDX),";;",2)
- if SDXX="QUIT"
- QUIT
- Begin DoDot:1
- +10 SET SDDA=+$ORDER(^DIC(40.7,"C",$PIECE(SDXX,U,2),0))
- +11 IF $DATA(^DIC(40.7,SDDA,0))
- Begin DoDot:2
- +12 SET DA=SDDA
- SET DR=".01///"_$PIECE(SDXX,U,4)
- SET DIE="^DIC(40.7,"
- +13 DO ^DIE
- DO MESC
- End DoDot:2
- End DoDot:1
- +14 KILL DIE,DR,DA
- +15 QUIT
- +16 ;
- MESS ;** Add message
- +1 NEW ECXADMSG
- +2 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +3 DO MES^XPDUTL(" ")
- +4 SET ECXADMSG="Added: "_$PIECE(SDXX,"^",2)_" "_$PIECE(SDXX,"^")
- +5 IF $PIECE(SDXX,"^",5)'=""
- SET ECXADMSG=ECXADMSG_" [CDR#: "_$PIECE(SDXX,"^",5)_"]"
- +6 DO MES^XPDUTL(ECXADMSG)
- +7 IF $PIECE(SDXX,"^",3)'=""
- SET ECXADMSG=" Restricted Type: "_$PIECE(SDXX,"^",3)_" Restricted Date: "_$PIECE(SDXX,"^",4)
- +8 DO MES^XPDUTL(ECXADMSG)
- +9 KILL SDVAR
- +10 QUIT
- +11 ;
- MESSEX ;** Display message if stop code already exists
- +1 NEW ECXADMSG
- +2 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +3 DO MES^XPDUTL(" ")
- +4 SET ECXADMSG=" "_$PIECE(SDXX,"^",2)_" "_$PIECE(SDXX,"^")_" already exists."
- +5 DO MES^XPDUTL(ECXADMSG)
- +6 KILL SDVAR
- +7 QUIT
- +8 ;
- MESC ;** Change message
- +1 NEW SDCMSG,SDCMSG1
- +2 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +3 DO MES^XPDUTL(" ")
- +4 SET SDCMSG="Changed: "_$PIECE(SDXX,U,2)_" "_$PIECE(SDXX,U)
- +5 SET SDCMSG1=" to: "_$PIECE(SDXX,U,2)_" "_$PIECE(SDXX,U,4)
- +6 DO MES^XPDUTL(SDCMSG)
- +7 DO MES^XPDUTL(SDCMSG1)
- +8 KILL SDVAR
- +9 QUIT
- +10 ;
- HDR(SDVAR) ;- Header
- +1 if '$GET(SDVAR)
- QUIT
- +2 NEW SDHDR
- +3 SET SDHDR=$PIECE($TEXT(@("HDR"_SDVAR)),";;",2)
- +4 DO BMES^XPDUTL(SDHDR)
- +5 QUIT
- +6 ;
- +7 ;
- HDR1 ;; Stop Code Name
- +1 ;
- HDR2 ;; CDR Stop Code Name
- +1 ;
- HDR3 ;; Stop Code Name Rest. Type Date
- +1 ;
- NEW ;DSS IDs to add- ex ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
- +1 ;;QUIT
- +2 ;
- CHNG ;DSS ID name changes- example ;;STOP CODE NAME^NUMBER^^NEW NAME
- +1 ;;PMRS CWT/SE NON-F TO F (MASNONCT)^223^^PMRS CWT/SE NON-F TO F (MAS NO
- +2 ;;PMRS CWT/TWE NON-F TO F (MASNONCT)^228^^PMRS CWT/TWE NON-F TO F (MAS N
- +3 ;;VISOR (VISUAL IMPAIRMENT OUTPATIENT PROGRAM)^220^^VISOR (VISL IMPRMT OUTPAT PGM)
- +4 ;;MH CWT/SE NON-F TO F (MAS NONCT^569^^MH CWT/SE NON-F TO F (MAS NONC
- +5 ;;MH CWT/TWE NON-F TO F (MAS NONCT^570^^MH CWT/TWE NON-F TO F (MAS NON
- +6 ;;NONVIDEO HOME TELEHEALTH INTERVENTION^684^^NONVIDEO HOME TELEHLTH INTRVNT
- +7 ;;QUIT