Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD53MY17

SD53MY17.m

Go to the documentation of this file.
  1. SD53MY17 ;ALB/TXH - Mid-FY17 Stop Code Update;09/01/16
  1. ;;5.3;Scheduling;**657**;AUG 13, 1993;Build 4
  1. ;
  1. ; This patch is used as a Post-Init in a KIDS build to modify
  1. ; the CLINIC STOP file [^DIC(40.7,] for Mid-FY2017 updates.
  1. ;
  1. Q
  1. ;
  1. EN ; Add/inactivate/change/reactivate DSS IDs (stop codes).
  1. ; The following code executes if file modifications exist.
  1. ;
  1. N SDVAR,SDAUMF,SDTYPE
  1. S SDAUMF=1
  1. L +^DIC(40.7):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T D Q
  1. . D BMES^XPDUTL("The CLINIC STOP file is not currently available. Please try again later.")
  1. D UPDATEDD("O") ;unlock file to allow edits
  1. D:$P($T(NEW+1),";;",2)'="QUIT" ADD
  1. D:$P($T(OLD+1),";;",2)'="QUIT" INACT
  1. D:$P($T(ACT+1),";;",2)'="QUIT" REACT
  1. D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
  1. D:$P($T(CDR+1),";;",2)'="QUIT" CDRNUM
  1. D:$P($T(REST+1),";;",2)'="QUIT" RESTR
  1. S SDAUMF=0
  1. D UPDATEDD("C") ;lock file back down
  1. L -^DIC(40.7)
  1. Q
  1. ;
  1. ;
  1. ADD ; Add DSS IDs
  1. ;
  1. ; SDXX is in format:
  1. ; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
  1. ;
  1. N SDX,SDXX
  1. S SDVAR=1
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Adding new Clinic Stops to CLINIC STOP (#40.7) file...")
  1. ;
  1. ; NOTE: The following line is for DSS IDs that are not yet active
  1. D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 04/01/2017]")
  1. S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(NEW+SDX),";;",2) Q:SDXX="QUIT" DO
  1. .S DIC("DR")="1////"_$P(SDXX,"^",2)_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))
  1. .S DIC("DR")=DIC("DR")_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
  1. .S X=$P(SDXX,"^",1)
  1. .I '$D(^DIC(40.7,"C",$P(SDXX,"^",2))) D FILE^DICN,MESS Q
  1. .I $D(^DIC(40.7,"C",$P(SDXX,"^",2))) D EDIT(SDXX),MESSEX
  1. K DIC,DLAYGO,X
  1. Q
  1. ;
  1. EDIT(SDXX) ; Edit fields w/new values if stop code record already exists
  1. ;
  1. Q:$G(SDXX)=""
  1. N DA,DIE,DLAYGO,DR
  1. S DA=+$O(^DIC(40.7,"C",+$P(SDXX,"^",2),0))
  1. Q:'DA
  1. S DIE="^DIC(40.7,"
  1. 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)
  1. D ^DIE
  1. Q
  1. INACT ; Inactivate DSS IDs
  1. ;
  1. ; SDXX is in format:
  1. ; AMIS #^^INACTIVATION DATE (in FileMan format)
  1. ;
  1. N SDX,SDDA,SDXX,SDINDT,SDEXDT
  1. S SDVAR=1
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Inactivating Clinic Stops in CLINIC STOP (#40.7) file...")
  1. D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date]")
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(OLD+SDX),";;",2) Q:SDXX="QUIT" DO
  1. . I +$P(SDXX,"^",3) D
  1. .. S X=$P(SDXX,"^",3)
  1. .. ;
  1. .. ;- Validate date passed in
  1. .. S %DT="FTX"
  1. .. D ^%DT
  1. .. Q:Y<0
  1. .. S SDINDT=Y
  1. .. D DD^%DT
  1. .. S SDEXDT=Y
  1. .. S SDDA=0
  1. .. F S SDDA=$O(^DIC(40.7,"C",+SDXX,SDDA)) Q:'SDDA D
  1. ... I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
  1. .... S DA=SDDA,DR="2////^S X=SDINDT",DIE="^DIC(40.7,"
  1. .... D ^DIE,MESI(SDEXDT)
  1. K %,%H,%I,DR,DA,DIC,DIE,DLAYGO,X,%DT,Y
  1. Q
  1. ;
  1. CHANGE ; Change DSS ID names
  1. ;
  1. ; SDXX is in format:
  1. ; STOP CODE NAME^AMIS #^^NEW STOP CODE NAME
  1. ;
  1. N SDX,SDXX,SDDA
  1. S SDVAR=1
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Changing Clinic Stop names in CLINIC STOP (#40.7) file...")
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CHNG+SDX),";;",2) Q:SDXX="QUIT" DO
  1. .S SDDA=0
  1. .F S SDDA=$O(^DIC(40.7,"C",$P(SDXX,U,2),SDDA)) Q:'SDDA D
  1. ..I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
  1. ...S DA=SDDA,DR=".01///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
  1. ...D ^DIE,MESC
  1. K DIE,DR,DA
  1. Q
  1. ;
  1. CDRNUM ; Change CDR numbers
  1. ;
  1. ; SDXX is in format:
  1. ; STOP CODE NAME (AMIS #) ^ AMIS # ^ OLD CDR # ^ NEW CDR #
  1. ;
  1. N SDX,SDXX,SDDA
  1. S SDVAR=2
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Changing CDR numbers in CLINIC STOP (#40.7) file...")
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CDR+SDX),";;",2) Q:SDXX="QUIT" DO
  1. .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
  1. .I $D(^DIC(40.7,SDDA,0)) DO
  1. ..S DA=SDDA,DR="4///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
  1. ..D ^DIE,MESN
  1. K DIE,DR,DA,X
  1. Q
  1. ;
  1. REACT ; Reactivate DSS IDs
  1. ;
  1. ; SDXX is in format:
  1. ; AMIS #^
  1. ;
  1. N SDX,SDDA,SDXX
  1. S SDVAR=1
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Reactivating Clinic Stops (DSS IDs) in CLINIC STOP (#40.7) file...")
  1. ; Inactivation date is an uneditable field, cannot use DIE to delete
  1. ; so must manually set piece to null if stop code being reactivated.
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(ACT+SDX),";;",2) Q:SDXX="QUIT" D
  1. .S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
  1. .I $P($G(^DIC(40.7,SDDA,0)),"^",3)'="" S $P(^DIC(40.7,SDDA,0),U,3)="" D MESA
  1. Q
  1. ;
  1. RESTR ; Change Restriction Data
  1. ;
  1. ; SDXX is in format:
  1. ; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
  1. ;
  1. N SDX,SDXX,SDDA
  1. S SDVAR=3
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP (#40.7) file...")
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(REST+SDX),";;",2) Q:SDXX="QUIT" D
  1. .S SDDA=0
  1. .F S SDDA=$O(^DIC(40.7,"C",$P(SDXX,U,2),SDDA)) Q:'SDDA D
  1. ..I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
  1. ...S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
  1. ...D ^DIE,MESR
  1. K DIE,DR,DA,X
  1. Q
  1. ;
  1. MESS ; Add message
  1. N ECXADMSG
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. ;
  1. I Y<0 D
  1. . S ECXADMSG="*** Error adding a new code: "_$P(SDXX,"^",2)_", please try again later. ***"
  1. . D MES^XPDUTL(ECXADMSG)
  1. ;
  1. I Y>0 D
  1. . S ECXADMSG="Added: "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")
  1. . I $P(SDXX,"^",5)'="" S ECXADMSG=ECXADMSG_" [CDR#: "_$P(SDXX,"^",5)_"]"
  1. . D MES^XPDUTL(ECXADMSG)
  1. . I $P(SDXX,"^",3)'="" S ECXADMSG=" Restricted Type: "_$P(SDXX,"^",3)_" Restricted Date: "_$P(SDXX,"^",4)
  1. . D MES^XPDUTL(ECXADMSG)
  1. K SDVAR
  1. Q
  1. ;
  1. MESSEX ; Display message if stop code already exists
  1. N ECXADMSG
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S ECXADMSG=" "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")_" already exists."
  1. D MES^XPDUTL(ECXADMSG)
  1. K SDVAR
  1. Q
  1. ;
  1. MESI(SDEXDT) ; Inactivate message
  1. ;
  1. ; Parameter:
  1. ; SDEXDT - Date inactivation affective (External Format)
  1. ;
  1. N SDINMSG
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. I $G(SDEXDT)="" S SDEXDT="UNKNOWN"
  1. D MES^XPDUTL(" ")
  1. S SDINMSG="Inactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")_" as of "_SDEXDT
  1. D MES^XPDUTL(SDINMSG)
  1. K SDVAR
  1. Q
  1. ;
  1. MESA ; Reactivate message
  1. ;
  1. N SDACMSG
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S SDACMSG="Reactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")
  1. D MES^XPDUTL(SDACMSG)
  1. K SDVAR
  1. Q
  1. ;
  1. MESC ; Change message
  1. N SDCMSG,SDCMSG1
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S SDCMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
  1. S SDCMSG1=" to: "_$P(SDXX,U,2)_" "_$P(SDXX,U,4)
  1. D MES^XPDUTL(SDCMSG)
  1. D MES^XPDUTL(SDCMSG1)
  1. K SDVAR
  1. Q
  1. ;
  1. MESN ; Change number
  1. N SDNMSG,SDNMSG1
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S SDNMSG=" Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
  1. S SDNMSG1=" : "_$P(SDXX,U,3)_" Date: "_$P(SDXX,U,5)
  1. D MES^XPDUTL(SDNMSG)
  1. D MES^XPDUTL(SDNMSG1)
  1. K SDVAR
  1. Q
  1. ;
  1. MESR ; Restricting Stop Code
  1. N SDNMSG,SDNMSG1
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S SDNMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)_" "_$P(SDXX,U,5)_" "_$P(SDXX,U,6)
  1. S SDNMSG1=" to: "_$P(SDXX,U,3)_" "_$P(SDXX,U,4)
  1. D MES^XPDUTL(SDNMSG)
  1. D MES^XPDUTL(SDNMSG1)
  1. K SDVAR
  1. Q
  1. ;
  1. HDR(SDVAR) ;- Header
  1. Q:'$G(SDVAR)
  1. N SDHDR
  1. S SDHDR=$P($T(@("HDR"_SDVAR)),";;",2)
  1. D BMES^XPDUTL(SDHDR)
  1. Q
  1. ;
  1. HDR1 ;; Stop Code Name
  1. ;
  1. HDR2 ;; CDR Stop Code Name
  1. ;
  1. HDR3 ;; Stop Code Name Rest. Type Date
  1. ;
  1. UPDATEDD(SDTYPE) ; Update DD for #40.7 to either unlock file to allow
  1. ; edits or lock file down to prohibit edits
  1. ; SDTYPE="O" to unlock file and SDTYPE="C" to lock file
  1. N I
  1. I SDTYPE="C" D ;restrict file edits "lockdown" file
  1. .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"
  1. .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
  1. I SDTYPE="O" D ;remove restrictions "unlock" file
  1. .K ^DD(40.7,.01,7.5)
  1. .F I=1:1:6 S $P(^DD(40.7,I,0),U,2)=$TR($P(^DD(40.7,I,0),U,2),"I","")
  1. Q
  1. ;
  1. 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^
  1. ;;QUIT
  1. ;
  1. OLD ;DSS IDs to be inactivated - ex. ;;AMIS NUMBER^^INACTIVE DATE
  1. ;;127^^4/1/2017
  1. ;;154^^4/1/2017
  1. ;;653^^4/1/2017
  1. ;;QUIT
  1. ;
  1. CHNG ;DSS ID name changes - ex. ;;STOP CODE NAME^NUMBER^^NEW NAME
  1. ;;WEIGHT CONTROL^139^^HEALTH/WELLBEING SRVS
  1. ;;COMP INTGR HEALTH^159^^CIH TREATMENT
  1. ;;QUIT
  1. ;
  1. CDR ;CDR account change - ex. ;;STOP CODE NAME^NUMBER^CDR # (old)^CDR# (new)
  1. ;;QUIT
  1. ;
  1. ACT ;DSS IDs to be reactivated - ex. ;;NUMBER^
  1. ;;139^
  1. ;;QUIT
  1. ;
  1. REST ;Change restriction - ex. ;;STOP CODE NAME^NUMBER^REST TYPE^RES DATE^OLD
  1. ;;QUIT