SD53151P ;ALB/ABR - DSS CLINIC STOP CODE FILE FOR DISTRIBUTION DRIVER; 9/18/98
;;5.3;Scheduling;**151**;AUG 13, 1993
;
; Driver to update sites 40.7 files to correspond with
; Nationally Distributed codes. Local codes (450-485)
; will not be affected.
;
EN ; driver entry point
N SDI,SDX,SDTX,SDTM
; Print list of flags used
F SDTX=1:1 S SDTM=$P($T(MSGT+SDTX),";;",2) Q:SDTM="QUIT" D MES^XPDUTL(SDTM)
;
; Get data from other routines
F SDI=1:1 S SDX=$P($T(DATA+SDI^SD53151A),";;",2) Q:SDX="QUIT" D UPDATE
F SDI=1:1 S SDX=$P($T(DATA+SDI^SD53151B),";;",2) Q:SDX="QUIT" D UPDATE
Q
;
UPDATE ;
N DIC,X,Y,DLAYGO,SDA,SDC,SDJ,SDY,SDM,SDZ
S DIC="^DIC(40.7,",DIC(0)="LMXZ",DLAYGO=40.7
S SDC=$P(SDX,U,2),X=$P(SDX,U)
F SDA=0:0 S SDA=$O(^DIC(40.7,"C",SDC,SDA)) Q:'SDA S Y=SDA,Y(0)=$G(^DIC(40.7,Y,0)) D UPD
Q:$G(Y) ; existing data already checked/updated
D ^DIC I Y<0 D BMES^XPDUTL("** Unable to find or add STOP CODE "_SDC),MES^XPDUTL("**Please contact Support")
;
UPD I $P(Y(0),U)=$P(SDX,U),$P(Y(0),U,2)=$P(SDX,U,2),$P(Y(0),U,3)=$P(SDX,U,3),$P(Y(0),U,5)=$P(SDX,U,4) Q ; no update needed
;
S SDZ=Y
F SDJ=1:1:4 S SDJ(SDJ)=$P(SDX,U,SDJ) ; from incoming
F SDY=1:1:4 S SDM=SDY S:SDY=4 SDM=5 S SDY(SDY)=$P(Y(0),U,SDM) ; from existing 0-node
F SDJ=3,4 I SDY(SDJ),'SDJ(SDJ) S SDJ(SDJ)="@" ; to delete CDR or inactive dates
D EDIT,MESS
Q
;
EDIT ; update entries
N DIE,DA,DR,X,Y
S DIE=DIC,DA=+SDZ,DR=".01///"_SDJ(1)_";1///"_SDC_";2///"_SDJ(3)_";4///"_SDJ(4)
D ^DIE
Q
;
MESS ;
N SDMSG
S SDMSG=" "_SDC
I $P(SDZ,U,3) S SDMSG="+"_SDMSG_" Added: "_SDJ(1)_" CDR: "_SDJ(4) D S SDMSG=SDMSG D MES^XPDUTL(SDMSG) Q
. I SDJ(3),'SDY(3) S SDMSG=SDMSG_" Inactive Date: "_$$FMTE^XLFDT(SDJ(3))
I SDJ(3),'SDY(3) S SDMSG="-"_SDMSG_" Inactivated: "_$$FMTE^XLFDT(SDJ(3)) D MES^XPDUTL(SDMSG) Q
I SDJ(3),SDY(3),SDJ(3)'=SDY(3) S SDMSG="%"_SDMSG_" Inactive Date changed to: "_$$FMTE^XLFDT(SDJ(3)) D MES^XPDUTL(SDMSG) Q
I SDJ(1)'=SDY(1) S SDMSG="*"_SDMSG_" Name Changed to: "_SDJ(1)
I SDJ(4)'=SDY(4) S SDMSG="!"_SDMSG_" Changed CDR: "_$S(SDJ(4):SDJ(4),1:"deleted.")
I SDY(3),'SDJ(3) S SDMSG="&"_SDMSG_" Reactivated"
;
MSG D MES^XPDUTL(SDMSG)
Q
;
MSGT ;
;; Changes are flagged such that:
;; '+' = Added
;; '-' = Inactivated
;; '&' = Reactivated
;; '%' = Inactive Date changed
;; '*' = Edited
;; '!' = CDR changed/deleted
;;
;;NOTE - If your list includes multiple entries for a Stop Code,
;; then you had duplicate entries in your file.
;;
;; This update will make ALL entries for a given Stop Code
;; the same, in order not to corrupt pointers.
;;
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53151P 2706 printed Dec 13, 2024@02:44:58 Page 2
SD53151P ;ALB/ABR - DSS CLINIC STOP CODE FILE FOR DISTRIBUTION DRIVER; 9/18/98
+1 ;;5.3;Scheduling;**151**;AUG 13, 1993
+2 ;
+3 ; Driver to update sites 40.7 files to correspond with
+4 ; Nationally Distributed codes. Local codes (450-485)
+5 ; will not be affected.
+6 ;
EN ; driver entry point
+1 NEW SDI,SDX,SDTX,SDTM
+2 ; Print list of flags used
+3 FOR SDTX=1:1
SET SDTM=$PIECE($TEXT(MSGT+SDTX),";;",2)
if SDTM="QUIT"
QUIT
DO MES^XPDUTL(SDTM)
+4 ;
+5 ; Get data from other routines
+6 FOR SDI=1:1
SET SDX=$PIECE($TEXT(DATA+SDI^SD53151A),";;",2)
if SDX="QUIT"
QUIT
DO UPDATE
+7 FOR SDI=1:1
SET SDX=$PIECE($TEXT(DATA+SDI^SD53151B),";;",2)
if SDX="QUIT"
QUIT
DO UPDATE
+8 QUIT
+9 ;
UPDATE ;
+1 NEW DIC,X,Y,DLAYGO,SDA,SDC,SDJ,SDY,SDM,SDZ
+2 SET DIC="^DIC(40.7,"
SET DIC(0)="LMXZ"
SET DLAYGO=40.7
+3 SET SDC=$PIECE(SDX,U,2)
SET X=$PIECE(SDX,U)
+4 FOR SDA=0:0
SET SDA=$ORDER(^DIC(40.7,"C",SDC,SDA))
if 'SDA
QUIT
SET Y=SDA
SET Y(0)=$GET(^DIC(40.7,Y,0))
DO UPD
+5 ; existing data already checked/updated
if $GET(Y)
QUIT
+6 DO ^DIC
IF Y<0
DO BMES^XPDUTL("** Unable to find or add STOP CODE "_SDC)
DO MES^XPDUTL("**Please contact Support")
+7 ;
UPD ; no update needed
IF $PIECE(Y(0),U)=$PIECE(SDX,U)
IF $PIECE(Y(0),U,2)=$PIECE(SDX,U,2)
IF $PIECE(Y(0),U,3)=$PIECE(SDX,U,3)
IF $PIECE(Y(0),U,5)=$PIECE(SDX,U,4)
QUIT
+1 ;
+2 SET SDZ=Y
+3 ; from incoming
FOR SDJ=1:1:4
SET SDJ(SDJ)=$PIECE(SDX,U,SDJ)
+4 ; from existing 0-node
FOR SDY=1:1:4
SET SDM=SDY
if SDY=4
SET SDM=5
SET SDY(SDY)=$PIECE(Y(0),U,SDM)
+5 ; to delete CDR or inactive dates
FOR SDJ=3,4
IF SDY(SDJ)
IF 'SDJ(SDJ)
SET SDJ(SDJ)="@"
+6 DO EDIT
DO MESS
+7 QUIT
+8 ;
EDIT ; update entries
+1 NEW DIE,DA,DR,X,Y
+2 SET DIE=DIC
SET DA=+SDZ
SET DR=".01///"_SDJ(1)_";1///"_SDC_";2///"_SDJ(3)_";4///"_SDJ(4)
+3 DO ^DIE
+4 QUIT
+5 ;
MESS ;
+1 NEW SDMSG
+2 SET SDMSG=" "_SDC
+3 IF $PIECE(SDZ,U,3)
SET SDMSG="+"_SDMSG_" Added: "_SDJ(1)_" CDR: "_SDJ(4)
Begin DoDot:1
+4 IF SDJ(3)
IF 'SDY(3)
SET SDMSG=SDMSG_" Inactive Date: "_$$FMTE^XLFDT(SDJ(3))
End DoDot:1
SET SDMSG=SDMSG
DO MES^XPDUTL(SDMSG)
QUIT
+5 IF SDJ(3)
IF 'SDY(3)
SET SDMSG="-"_SDMSG_" Inactivated: "_$$FMTE^XLFDT(SDJ(3))
DO MES^XPDUTL(SDMSG)
QUIT
+6 IF SDJ(3)
IF SDY(3)
IF SDJ(3)'=SDY(3)
SET SDMSG="%"_SDMSG_" Inactive Date changed to: "_$$FMTE^XLFDT(SDJ(3))
DO MES^XPDUTL(SDMSG)
QUIT
+7 IF SDJ(1)'=SDY(1)
SET SDMSG="*"_SDMSG_" Name Changed to: "_SDJ(1)
+8 IF SDJ(4)'=SDY(4)
SET SDMSG="!"_SDMSG_" Changed CDR: "_$SELECT(SDJ(4):SDJ(4),1:"deleted.")
+9 IF SDY(3)
IF 'SDJ(3)
SET SDMSG="&"_SDMSG_" Reactivated"
+10 ;
MSG DO MES^XPDUTL(SDMSG)
+1 QUIT
+2 ;
MSGT ;
+1 ;; Changes are flagged such that:
+2 ;; '+' = Added
+3 ;; '-' = Inactivated
+4 ;; '&' = Reactivated
+5 ;; '%' = Inactive Date changed
+6 ;; '*' = Edited
+7 ;; '!' = CDR changed/deleted
+8 ;;
+9 ;;NOTE - If your list includes multiple entries for a Stop Code,
+10 ;; then you had duplicate entries in your file.
+11 ;;
+12 ;; This update will make ALL entries for a given Stop Code
+13 ;; the same, in order not to corrupt pointers.
+14 ;;
+15 ;;QUIT
