- SD53MY17 ;ALB/TXH - Mid-FY17 Stop Code Update;09/01/16
- ;;5.3;Scheduling;**657**;AUG 13, 1993;Build 4
- ;
- ; This patch is used as a Post-Init in a KIDS build to modify
- ; the CLINIC STOP file [^DIC(40.7,] for Mid-FY2017 updates.
- ;
- Q
- ;
- EN ; Add/inactivate/change/reactivate DSS IDs (stop codes).
- ; The following code executes if file modifications exist.
- ;
- N SDVAR,SDAUMF,SDTYPE
- S SDAUMF=1
- L +^DIC(40.7):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T D Q
- . D BMES^XPDUTL("The CLINIC STOP file is not currently available. Please try again later.")
- D UPDATEDD("O") ;unlock file to allow edits
- D:$P($T(NEW+1),";;",2)'="QUIT" ADD
- D:$P($T(OLD+1),";;",2)'="QUIT" INACT
- D:$P($T(ACT+1),";;",2)'="QUIT" REACT
- D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
- D:$P($T(CDR+1),";;",2)'="QUIT" CDRNUM
- D:$P($T(REST+1),";;",2)'="QUIT" RESTR
- S SDAUMF=0
- D UPDATEDD("C") ;lock file back down
- L -^DIC(40.7)
- 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 to CLINIC STOP (#40.7) file...")
- ;
- ; NOTE: The following line is for DSS IDs that are not yet active
- D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 04/01/2017]")
- 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,"
- S 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
- INACT ; Inactivate DSS IDs
- ;
- ; SDXX is in format:
- ; AMIS #^^INACTIVATION DATE (in FileMan format)
- ;
- N SDX,SDDA,SDXX,SDINDT,SDEXDT
- S SDVAR=1
- D MES^XPDUTL("")
- D BMES^XPDUTL(">>> Inactivating Clinic Stops in CLINIC STOP (#40.7) file...")
- D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date]")
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(OLD+SDX),";;",2) Q:SDXX="QUIT" DO
- . I +$P(SDXX,"^",3) D
- .. S X=$P(SDXX,"^",3)
- .. ;
- .. ;- Validate date passed in
- .. S %DT="FTX"
- .. D ^%DT
- .. Q:Y<0
- .. S SDINDT=Y
- .. D DD^%DT
- .. S SDEXDT=Y
- .. S SDDA=0
- .. F S SDDA=$O(^DIC(40.7,"C",+SDXX,SDDA)) Q:'SDDA D
- ... I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
- .... S DA=SDDA,DR="2////^S X=SDINDT",DIE="^DIC(40.7,"
- .... D ^DIE,MESI(SDEXDT)
- K %,%H,%I,DR,DA,DIC,DIE,DLAYGO,X,%DT,Y
- 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 names in CLINIC STOP (#40.7) file...")
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CHNG+SDX),";;",2) Q:SDXX="QUIT" DO
- .S SDDA=0
- .F S SDDA=$O(^DIC(40.7,"C",$P(SDXX,U,2),SDDA)) Q:'SDDA D
- ..I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
- ...S DA=SDDA,DR=".01///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
- ...D ^DIE,MESC
- K DIE,DR,DA
- Q
- ;
- CDRNUM ; Change CDR numbers
- ;
- ; SDXX is in format:
- ; STOP CODE NAME (AMIS #) ^ AMIS # ^ OLD CDR # ^ NEW CDR #
- ;
- N SDX,SDXX,SDDA
- S SDVAR=2
- D MES^XPDUTL("")
- D BMES^XPDUTL(">>> Changing CDR numbers in CLINIC STOP (#40.7) file...")
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CDR+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="4///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
- ..D ^DIE,MESN
- K DIE,DR,DA,X
- Q
- ;
- REACT ; Reactivate DSS IDs
- ;
- ; SDXX is in format:
- ; AMIS #^
- ;
- N SDX,SDDA,SDXX
- S SDVAR=1
- D MES^XPDUTL("")
- D BMES^XPDUTL(">>> Reactivating Clinic Stops (DSS IDs) in CLINIC STOP (#40.7) file...")
- ; Inactivation date is an uneditable field, cannot use DIE to delete
- ; so must manually set piece to null if stop code being reactivated.
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(ACT+SDX),";;",2) Q:SDXX="QUIT" D
- .S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
- .I $P($G(^DIC(40.7,SDDA,0)),"^",3)'="" S $P(^DIC(40.7,SDDA,0),U,3)="" D MESA
- Q
- ;
- RESTR ; Change Restriction Data
- ;
- ; SDXX is in format:
- ; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
- ;
- N SDX,SDXX,SDDA
- S SDVAR=3
- D MES^XPDUTL("")
- D BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP (#40.7) file...")
- F SDX=1:1 K DD,DO,DA S SDXX=$P($T(REST+SDX),";;",2) Q:SDXX="QUIT" D
- .S SDDA=0
- .F S SDDA=$O(^DIC(40.7,"C",$P(SDXX,U,2),SDDA)) Q:'SDDA D
- ..I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
- ...S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
- ...D ^DIE,MESR
- K DIE,DR,DA,X
- Q
- ;
- MESS ; Add message
- N ECXADMSG
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- ;
- I Y<0 D
- . S ECXADMSG="*** Error adding a new code: "_$P(SDXX,"^",2)_", please try again later. ***"
- . D MES^XPDUTL(ECXADMSG)
- ;
- I Y>0 D
- . 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
- ;
- MESI(SDEXDT) ; Inactivate message
- ;
- ; Parameter:
- ; SDEXDT - Date inactivation affective (External Format)
- ;
- N SDINMSG
- I +$G(SDVAR) D HDR(SDVAR)
- I $G(SDEXDT)="" S SDEXDT="UNKNOWN"
- D MES^XPDUTL(" ")
- S SDINMSG="Inactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")_" as of "_SDEXDT
- D MES^XPDUTL(SDINMSG)
- K SDVAR
- Q
- ;
- MESA ; Reactivate message
- ;
- N SDACMSG
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- S SDACMSG="Reactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")
- D MES^XPDUTL(SDACMSG)
- 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
- ;
- MESN ; Change number
- N SDNMSG,SDNMSG1
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- S SDNMSG=" Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
- S SDNMSG1=" : "_$P(SDXX,U,3)_" Date: "_$P(SDXX,U,5)
- D MES^XPDUTL(SDNMSG)
- D MES^XPDUTL(SDNMSG1)
- K SDVAR
- Q
- ;
- MESR ; Restricting Stop Code
- N SDNMSG,SDNMSG1
- I +$G(SDVAR) D HDR(SDVAR)
- D MES^XPDUTL(" ")
- S SDNMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)_" "_$P(SDXX,U,5)_" "_$P(SDXX,U,6)
- S SDNMSG1=" to: "_$P(SDXX,U,3)_" "_$P(SDXX,U,4)
- D MES^XPDUTL(SDNMSG)
- D MES^XPDUTL(SDNMSG1)
- 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
- ;
- UPDATEDD(SDTYPE) ; Update DD for #40.7 to either unlock file to allow
- ; edits or lock file down to prohibit edits
- ; SDTYPE="O" to unlock file and SDTYPE="C" to lock file
- N I
- I SDTYPE="C" D ;restrict file edits "lockdown" file
- .S ^DD(40.7,.01,7.5)="I $G(DIC(0))[""L"",'$D(SDAUMF) D EN^DDIOL(""Entries can only be added by the Stop Code Council."","""",""!?5"") K X"
- .F I=1:1:6 I $P(^DD(40.7,I,0),U,2)'["I" S $P(^DD(40.7,I,0),U,2)=$P(^DD(40.7,I,0),U,2)_"I" ;makes all fields uneditable
- I SDTYPE="O" D ;remove restrictions "unlock" file
- .K ^DD(40.7,.01,7.5)
- .F I=1:1:6 S $P(^DD(40.7,I,0),U,2)=$TR($P(^DD(40.7,I,0),U,2),"I","")
- Q
- ;
- NEW ; DSS IDs to add - ex. ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
- ;;NC CVT TO HOME PROVID LOC^679^S^4/1/2017^
- ;;QUIT
- ;
- OLD ;DSS IDs to be inactivated - ex. ;;AMIS NUMBER^^INACTIVE DATE
- ;;127^^4/1/2017
- ;;154^^4/1/2017
- ;;653^^4/1/2017
- ;;QUIT
- ;
- CHNG ;DSS ID name changes - ex. ;;STOP CODE NAME^NUMBER^^NEW NAME
- ;;WEIGHT CONTROL^139^^HEALTH/WELLBEING SRVS
- ;;COMP INTGR HEALTH^159^^CIH TREATMENT
- ;;QUIT
- ;
- CDR ;CDR account change - ex. ;;STOP CODE NAME^NUMBER^CDR # (old)^CDR# (new)
- ;;QUIT
- ;
- ACT ;DSS IDs to be reactivated - ex. ;;NUMBER^
- ;;139^
- ;;QUIT
- ;
- REST ;Change restriction - ex. ;;STOP CODE NAME^NUMBER^REST TYPE^RES DATE^OLD
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53MY17 9090 printed Feb 19, 2025@00:12:23 Page 2
- SD53MY17 ;ALB/TXH - Mid-FY17 Stop Code Update;09/01/16
- +1 ;;5.3;Scheduling;**657**;AUG 13, 1993;Build 4
- +2 ;
- +3 ; This patch is used as a Post-Init in a KIDS build to modify
- +4 ; the CLINIC STOP file [^DIC(40.7,] for Mid-FY2017 updates.
- +5 ;
- +6 QUIT
- +7 ;
- EN ; Add/inactivate/change/reactivate DSS IDs (stop codes).
- +1 ; The following code executes if file modifications exist.
- +2 ;
- +3 NEW SDVAR,SDAUMF,SDTYPE
- +4 SET SDAUMF=1
- +5 LOCK +^DIC(40.7):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
- IF '$TEST
- Begin DoDot:1
- +6 DO BMES^XPDUTL("The CLINIC STOP file is not currently available. Please try again later.")
- End DoDot:1
- QUIT
- +7 ;unlock file to allow edits
- DO UPDATEDD("O")
- +8 if $PIECE($TEXT(NEW+1),";;",2)'="QUIT"
- DO ADD
- +9 if $PIECE($TEXT(OLD+1),";;",2)'="QUIT"
- DO INACT
- +10 if $PIECE($TEXT(ACT+1),";;",2)'="QUIT"
- DO REACT
- +11 if $PIECE($TEXT(CHNG+1),";;",2)'="QUIT"
- DO CHANGE
- +12 if $PIECE($TEXT(CDR+1),";;",2)'="QUIT"
- DO CDRNUM
- +13 if $PIECE($TEXT(REST+1),";;",2)'="QUIT"
- DO RESTR
- +14 SET SDAUMF=0
- +15 ;lock file back down
- DO UPDATEDD("C")
- +16 LOCK -^DIC(40.7)
- +17 QUIT
- +18 ;
- +19 ;
- 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 to CLINIC STOP (#40.7) file...")
- +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 04/01/2017]")
- +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 IF $DATA(^DIC(40.7,"C",$PIECE(SDXX,"^",2)))
- DO EDIT(SDXX)
- DO 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,"
- +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)
- +8 DO ^DIE
- +9 QUIT
- INACT ; Inactivate DSS IDs
- +1 ;
- +2 ; SDXX is in format:
- +3 ; AMIS #^^INACTIVATION DATE (in FileMan format)
- +4 ;
- +5 NEW SDX,SDDA,SDXX,SDINDT,SDEXDT
- +6 SET SDVAR=1
- +7 DO MES^XPDUTL("")
- +8 DO BMES^XPDUTL(">>> Inactivating Clinic Stops in CLINIC STOP (#40.7) file...")
- +9 DO BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date]")
- +10 FOR SDX=1:1
- KILL DD,DO,DA
- SET SDXX=$PIECE($TEXT(OLD+SDX),";;",2)
- if SDXX="QUIT"
- QUIT
- Begin DoDot:1
- +11 IF +$PIECE(SDXX,"^",3)
- Begin DoDot:2
- +12 SET X=$PIECE(SDXX,"^",3)
- +13 ;
- +14 ;- Validate date passed in
- +15 SET %DT="FTX"
- +16 DO ^%DT
- +17 if Y<0
- QUIT
- +18 SET SDINDT=Y
- +19 DO DD^%DT
- +20 SET SDEXDT=Y
- +21 SET SDDA=0
- +22 FOR
- SET SDDA=$ORDER(^DIC(40.7,"C",+SDXX,SDDA))
- if 'SDDA
- QUIT
- Begin DoDot:3
- +23 IF $DATA(^DIC(40.7,SDDA,0))
- IF $PIECE(^(0),U,3)=""
- Begin DoDot:4
- +24 SET DA=SDDA
- SET DR="2////^S X=SDINDT"
- SET DIE="^DIC(40.7,"
- +25 DO ^DIE
- DO MESI(SDEXDT)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +26 KILL %,%H,%I,DR,DA,DIC,DIE,DLAYGO,X,%DT,Y
- +27 QUIT
- +28 ;
- 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 names in CLINIC STOP (#40.7) file...")
- +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=0
- +11 FOR
- SET SDDA=$ORDER(^DIC(40.7,"C",$PIECE(SDXX,U,2),SDDA))
- if 'SDDA
- QUIT
- Begin DoDot:2
- +12 IF $DATA(^DIC(40.7,SDDA,0))
- IF $PIECE(^(0),U,3)=""
- Begin DoDot:3
- +13 SET DA=SDDA
- SET DR=".01///"_$PIECE(SDXX,U,4)
- SET DIE="^DIC(40.7,"
- +14 DO ^DIE
- DO MESC
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 KILL DIE,DR,DA
- +16 QUIT
- +17 ;
- CDRNUM ; Change CDR numbers
- +1 ;
- +2 ; SDXX is in format:
- +3 ; STOP CODE NAME (AMIS #) ^ AMIS # ^ OLD CDR # ^ NEW CDR #
- +4 ;
- +5 NEW SDX,SDXX,SDDA
- +6 SET SDVAR=2
- +7 DO MES^XPDUTL("")
- +8 DO BMES^XPDUTL(">>> Changing CDR numbers in CLINIC STOP (#40.7) file...")
- +9 FOR SDX=1:1
- KILL DD,DO,DA
- SET SDXX=$PIECE($TEXT(CDR+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="4///"_$PIECE(SDXX,U,4)
- SET DIE="^DIC(40.7,"
- +13 DO ^DIE
- DO MESN
- End DoDot:2
- End DoDot:1
- +14 KILL DIE,DR,DA,X
- +15 QUIT
- +16 ;
- REACT ; Reactivate DSS IDs
- +1 ;
- +2 ; SDXX is in format:
- +3 ; AMIS #^
- +4 ;
- +5 NEW SDX,SDDA,SDXX
- +6 SET SDVAR=1
- +7 DO MES^XPDUTL("")
- +8 DO BMES^XPDUTL(">>> Reactivating Clinic Stops (DSS IDs) in CLINIC STOP (#40.7) file...")
- +9 ; Inactivation date is an uneditable field, cannot use DIE to delete
- +10 ; so must manually set piece to null if stop code being reactivated.
- +11 FOR SDX=1:1
- KILL DD,DO,DA
- SET SDXX=$PIECE($TEXT(ACT+SDX),";;",2)
- if SDXX="QUIT"
- QUIT
- Begin DoDot:1
- +12 SET SDDA=+$ORDER(^DIC(40.7,"C",+SDXX,0))
- +13 IF $PIECE($GET(^DIC(40.7,SDDA,0)),"^",3)'=""
- SET $PIECE(^DIC(40.7,SDDA,0),U,3)=""
- DO MESA
- End DoDot:1
- +14 QUIT
- +15 ;
- RESTR ; Change Restriction Data
- +1 ;
- +2 ; SDXX is in format:
- +3 ; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
- +4 ;
- +5 NEW SDX,SDXX,SDDA
- +6 SET SDVAR=3
- +7 DO MES^XPDUTL("")
- +8 DO BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP (#40.7) file...")
- +9 FOR SDX=1:1
- KILL DD,DO,DA
- SET SDXX=$PIECE($TEXT(REST+SDX),";;",2)
- if SDXX="QUIT"
- QUIT
- Begin DoDot:1
- +10 SET SDDA=0
- +11 FOR
- SET SDDA=$ORDER(^DIC(40.7,"C",$PIECE(SDXX,U,2),SDDA))
- if 'SDDA
- QUIT
- Begin DoDot:2
- +12 IF $DATA(^DIC(40.7,SDDA,0))
- IF $PIECE(^(0),U,3)=""
- Begin DoDot:3
- +13 SET DA=SDDA
- SET DR="5////"_$PIECE(SDXX,U,3)_";6///"_$PIECE(SDXX,U,4)
- SET DIE="^DIC(40.7,"
- +14 DO ^DIE
- DO MESR
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 KILL DIE,DR,DA,X
- +16 QUIT
- +17 ;
- MESS ; Add message
- +1 NEW ECXADMSG
- +2 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +3 DO MES^XPDUTL(" ")
- +4 ;
- +5 IF Y<0
- Begin DoDot:1
- +6 SET ECXADMSG="*** Error adding a new code: "_$PIECE(SDXX,"^",2)_", please try again later. ***"
- +7 DO MES^XPDUTL(ECXADMSG)
- End DoDot:1
- +8 ;
- +9 IF Y>0
- Begin DoDot:1
- +10 SET ECXADMSG="Added: "_$PIECE(SDXX,"^",2)_" "_$PIECE(SDXX,"^")
- +11 IF $PIECE(SDXX,"^",5)'=""
- SET ECXADMSG=ECXADMSG_" [CDR#: "_$PIECE(SDXX,"^",5)_"]"
- +12 DO MES^XPDUTL(ECXADMSG)
- +13 IF $PIECE(SDXX,"^",3)'=""
- SET ECXADMSG=" Restricted Type: "_$PIECE(SDXX,"^",3)_" Restricted Date: "_$PIECE(SDXX,"^",4)
- +14 DO MES^XPDUTL(ECXADMSG)
- End DoDot:1
- +15 KILL SDVAR
- +16 QUIT
- +17 ;
- 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 ;
- MESI(SDEXDT) ; Inactivate message
- +1 ;
- +2 ; Parameter:
- +3 ; SDEXDT - Date inactivation affective (External Format)
- +4 ;
- +5 NEW SDINMSG
- +6 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +7 IF $GET(SDEXDT)=""
- SET SDEXDT="UNKNOWN"
- +8 DO MES^XPDUTL(" ")
- +9 SET SDINMSG="Inactivated: "_+SDXX_" "_$PIECE($GET(^DIC(40.7,SDDA,0)),"^")_" as of "_SDEXDT
- +10 DO MES^XPDUTL(SDINMSG)
- +11 KILL SDVAR
- +12 QUIT
- +13 ;
- MESA ; Reactivate message
- +1 ;
- +2 NEW SDACMSG
- +3 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +4 DO MES^XPDUTL(" ")
- +5 SET SDACMSG="Reactivated: "_+SDXX_" "_$PIECE($GET(^DIC(40.7,SDDA,0)),"^")
- +6 DO MES^XPDUTL(SDACMSG)
- +7 KILL SDVAR
- +8 QUIT
- +9 ;
- 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 ;
- MESN ; Change number
- +1 NEW SDNMSG,SDNMSG1
- +2 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +3 DO MES^XPDUTL(" ")
- +4 SET SDNMSG=" Changed: "_$PIECE(SDXX,U,2)_" "_$PIECE(SDXX,U)
- +5 SET SDNMSG1=" : "_$PIECE(SDXX,U,3)_" Date: "_$PIECE(SDXX,U,5)
- +6 DO MES^XPDUTL(SDNMSG)
- +7 DO MES^XPDUTL(SDNMSG1)
- +8 KILL SDVAR
- +9 QUIT
- +10 ;
- MESR ; Restricting Stop Code
- +1 NEW SDNMSG,SDNMSG1
- +2 IF +$GET(SDVAR)
- DO HDR(SDVAR)
- +3 DO MES^XPDUTL(" ")
- +4 SET SDNMSG="Changed: "_$PIECE(SDXX,U,2)_" "_$PIECE(SDXX,U)_" "_$PIECE(SDXX,U,5)_" "_$PIECE(SDXX,U,6)
- +5 SET SDNMSG1=" to: "_$PIECE(SDXX,U,3)_" "_$PIECE(SDXX,U,4)
- +6 DO MES^XPDUTL(SDNMSG)
- +7 DO MES^XPDUTL(SDNMSG1)
- +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 ;
- HDR1 ;; Stop Code Name
- +1 ;
- HDR2 ;; CDR Stop Code Name
- +1 ;
- HDR3 ;; Stop Code Name Rest. Type Date
- +1 ;
- UPDATEDD(SDTYPE) ; Update DD for #40.7 to either unlock file to allow
- +1 ; edits or lock file down to prohibit edits
- +2 ; SDTYPE="O" to unlock file and SDTYPE="C" to lock file
- +3 NEW I
- +4 ;restrict file edits "lockdown" file
- IF SDTYPE="C"
- Begin DoDot:1
- +5 SET ^DD(40.7,.01,7.5)="I $G(DIC(0))[""L"",'$D(SDAUMF) D EN^DDIOL(""Entries can only be added by the Stop Code Council."","""",""!?5"") K X"
- +6 ;makes all fields uneditable
- FOR I=1:1:6
- IF $PIECE(^DD(40.7,I,0),U,2)'["I"
- SET $PIECE(^DD(40.7,I,0),U,2)=$PIECE(^DD(40.7,I,0),U,2)_"I"
- End DoDot:1
- +7 ;remove restrictions "unlock" file
- IF SDTYPE="O"
- Begin DoDot:1
- +8 KILL ^DD(40.7,.01,7.5)
- +9 FOR I=1:1:6
- SET $PIECE(^DD(40.7,I,0),U,2)=$TRANSLATE($PIECE(^DD(40.7,I,0),U,2),"I","")
- End DoDot:1
- +10 QUIT
- +11 ;
- NEW ; DSS IDs to add - ex. ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
- +1 ;;NC CVT TO HOME PROVID LOC^679^S^4/1/2017^
- +2 ;;QUIT
- +3 ;
- OLD ;DSS IDs to be inactivated - ex. ;;AMIS NUMBER^^INACTIVE DATE
- +1 ;;127^^4/1/2017
- +2 ;;154^^4/1/2017
- +3 ;;653^^4/1/2017
- +4 ;;QUIT
- +5 ;
- CHNG ;DSS ID name changes - ex. ;;STOP CODE NAME^NUMBER^^NEW NAME
- +1 ;;WEIGHT CONTROL^139^^HEALTH/WELLBEING SRVS
- +2 ;;COMP INTGR HEALTH^159^^CIH TREATMENT
- +3 ;;QUIT
- +4 ;
- CDR ;CDR account change - ex. ;;STOP CODE NAME^NUMBER^CDR # (old)^CDR# (new)
- +1 ;;QUIT
- +2 ;
- ACT ;DSS IDs to be reactivated - ex. ;;NUMBER^
- +1 ;;139^
- +2 ;;QUIT
- +3 ;
- REST ;Change restriction - ex. ;;STOP CODE NAME^NUMBER^REST TYPE^RES DATE^OLD
- +1 ;;QUIT