- 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 Feb 19, 2025@00:11:25 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
