SD132PT ;ALB/MJK - Patch SD*5.3*132 Post-Init Routine ; 11/5/97
;;5.3;Scheduling;**132**;Aug 13, 1993
;
EN ; --- main entry point
S U="^"
D BMES^XPDUTL("Post-Init Started...")
;
; -- main driver calls
D MAS,HL,LOG,ACG,AG,OVER
;
D BMES^XPDUTL("Post-Init Finished.")
Q
;
MAS ; -- delete MAS PARAMETERS (#43) fields and related data
N SDARY
;
D BMES^XPDUTL(" >>> Deleting MAS PARAMETERS (#43) fields...")
;
; -- get fields to delete
D BUILDR(43,.SDARY)
;
IF '$O(SDARY(0)) G MASQ
;
; -- delete data
N SDFDA,SDFLD
S SDFLD=0
F S SDFLD=$O(SDARY(SDFLD)) Q:'SDFLD D
. S SDFDA(43,"1,",SDFLD)="@"
D FILE^DIE("S","SDFDA")
;
; -- delete dds
D DELDD(43)
MASQ D MES^XPDUTL(" >>> Done.")
Q
;
HL ; -- delete HOSPITIAL LOCATION (#44) fields and related data
N SDARY
;
D BMES^XPDUTL(" >>> Deleting HOSPITAL LOCATION (#44) fields...")
;
; -- get fields to delete
D BUILDR(44,.SDARY)
;
IF '$O(SDARY(0)) G HLQ
;
; -- delete data
S SDIEN=0
F S SDIEN=$O(^SC(SDIEN)) Q:'SDIEN D
. N SDFDA,SDFLD
. S SDFLD=0
. F S SDFLD=$O(SDARY(SDFLD)) Q:'SDFLD D
. . S SDFDA(44,SDIEN_",",SDFLD)="@"
. D FILE^DIE("S","SDFDA")
;
; -- delete dds
D DELDD(44)
HLQ D MES^XPDUTL(" >>> Done.")
Q
;
LOG ; -- delete APPOINTMENT STATUS UPDATE LOG (#409.65) fields and related data
N SDARY
;
D BMES^XPDUTL(" >>> Deleting APPPOINT STATUS UPDATE LOG (409.65) fields...")
;
; -- get fields to delete
D BUILDR(409.65,.SDARY)
;
IF '$O(SDARY(0)) G LOGQ
;
; -- delete data
S SDIEN=0
F S SDIEN=$O(^SDD(409.65,SDIEN)) Q:'SDIEN D
. N SDFDA,SDFLD
. S SDFLD=0
. F S SDFLD=$O(SDARY(SDFLD)) Q:'SDFLD D
. . S SDFDA(409.65,SDIEN_",",SDFLD)="@"
. D FILE^DIE("S","SDFDA")
;
; -- delete dds
D DELDD(409.65)
LOGQ D MES^XPDUTL(" >>> Done.")
Q
;
ACG ; -- update new computer generated appt type related fields in
; OUTPATIENT ENCOUNTER (#409.68) with data for ^SDV data
;
D BMES^XPDUTL(" >>> Setting 'ACG' cross references...")
;
; -- scan ^SDV("ACG") for records
N SDATE,SDCS,SDCS0,SDOE,SDOE0,SDREASON,SDAPPT,SDCG,DR,DA,DIE
S SDATE=0
F S SDATE=$O(^SDV("ACG",SDATE)) Q:'SDATE D
. S SDCS=0 F S SDCS=$O(^SDV("ACG",SDATE,SDCS)) Q:'SDCS D
. . S SDCS0=$G(^SDV(SDATE,"CS",SDCS,0))
. . S SDCG=+$G(^SDV(SDATE,"CS",SDCS,1))
. . S SDAPPT=$P(SDCS0,U,5)
. . S SDREASON=$P(SDCS0,U,6)
. . S SDOE=+$P(SDCS0,U,8)
. . S SDOE0=$G(^SCE(SDOE,0))
. . IF SDAPPT=10,SDOE,$P(SDOE0,U,10)=10,$G(^SCE(SDOE,"CG"))="" D
. . . S DR=".1////10"
. . . IF SDCG S DR=DR_";201////1"
. . . IF SDREASON S DR=DR_";202////"_SDREASON
. . . S DIE="^SCE(",DA=SDOE D ^DIE
;
D MES^XPDUTL(" >>> Done.")
Q
;
AG ; -- queue job to set 'AG' xref and related fields
N SDUZ,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSAVE,ZTSK
S SDUZ=$G(DUZ)
D BMES^XPDUTL(" >>> Queuing task to set 'AG' cross reference.")
; -- disable option
D OUT^XPDMENU("SDACS CGSCLIST","AG Cross Reference Being Set")
D MES^XPDUTL(" -> Option 'SDACS CGSCLIST' has been placed out of service.")
;
; -- queue task
S ZTIO=""
S ZTRTN="AGQUE^SD132PT"
S ZTDESC="Setting 'AG' Cross Reference"
S ZTDTH=$$NOW^XLFDT()
F X="SDUZ" S ZTSAVE(X)=""
D ^%ZTLOAD
D:$D(ZTSK) MES^XPDUTL(" -> Task: #"_ZTSK)
D MES^XPDUTL(" >>> Done.")
Q
;
AGQUE ; -- TaskMan entry point to queue 'AG' setting
;
N SDATE,SDCS,SDCS0,SDOE,SDREASON,SDCG,DR,DA,DIE,SDSTOP,SDTOT,SDBEG,SDEND
;
S SDTOT=0
S SDBEG=$$NOW^XLFDT()
;
; -- scan ^SDV("AG") for records
S SDATE=0
F S SDATE=$O(^SDV("AG",SDATE)) Q:'SDATE D S SDSTOP=$$S^%ZTLOAD Q:SDSTOP
. S SDCS=0 F S SDCS=$O(^SDV("AG",SDATE,SDCS)) Q:'SDCS D
. . S SDCS0=$G(^SDV(SDATE,"CS",SDCS,0))
. . S SDCG=+$G(^SDV(SDATE,"CS",SDCS,1))
. . S SDOE=+$P(SDCS0,U,8)
. . S SDREASON=$P(SDCS0,U,6)
. . IF SDOE,$G(^SCE(SDOE,0))]"",$G(^SCE(SDOE,"CG"))="",SDCG D
. . . S DR="201////1"
. . . IF SDREASON S DR=DR_";202////"_SDREASON
. . . S DIE="^SCE(",DA=SDOE D ^DIE
. . . S SDTOT=SDTOT+1
;
S SDEND=$$NOW^XLFDT()
; -- send bulletin and enable option
D BULL
Q
;
BULL ; -- send message indicating 'AG' xref is set and option enabled
N SDTEXT,SDCNT,XMSUB,XMN,XMTEXT,XMDUZ,XMY
S SDCNT=0
;
D LINE("")
D LINE(" >>> Task Started: "_$$FMTE^XLFDT(SDBEG))
D LINE(" Finished: "_$$FMTE^XLFDT(SDEND))
D LINE("")
;
; -- build text
IF SDSTOP D
. D LINE(" >>> Task stopped by user. <<<")
ELSE D
. ; -- enable option
. D OUT^XPDMENU("SDACS CGSCLIST","")
. ;
. ; -- build text
. D LINE(" >>> Task Completed.")
. D LINE("")
. D LINE(" >>> Option 'SDACS CGSCLIST' is back in service.")
;
D LINE("")
D LINE(" >>> "_SDTOT_" Records processed.")
; -- set xm vars and send message
S XMSUB="Setting of 'AG' Cross Reference Task Information"
S XMN=0
S XMTEXT="SDTEXT("
S XMDUZ=.5
S XMY(SDUZ)=""
D ^XMD
Q
;
OVER ; -- post override flag information
N SDPKG,SDCNT
;
D BMES^XPDUTL(" >>> Package Override Flag Information")
;
S SDPKG="A",SDCNT=0
F S SDPKG=$O(^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)) Q:SDPKG="" D
. D MES^XPDUTL(" -> Override flag set for '"_SDPKG_"'")
. S SDCNT=SDCNT+1
;
IF 'SDCNT D MES^XPDUTL(" -> No package override flags set.")
D MES^XPDUTL(" >>> Done.")
Q
;
LINE(TEXT) ; -- add line of text
S SDCNT=SDCNT+1
S SDTEXT(SDCNT)=TEXT
Q
;
BUILDR(SDD,SDARY) ; -- build array of fields to delete
N SDI,SDX,SDENDFLG
S SDENDFLG="$$END$$"
;
F SDI=1:1 S SDX=$P($T(FLDS+SDI),";;",2) Q:SDX=SDENDFLG D
. N SDFILE,SDFLD
. S SDFILE=+SDX
. S SDFLD=+$P(SDX,U,2)
. S SDNAME=$P(SDX,U,3)
. IF SDD=SDFILE,$$LABEL(SDFILE,SDFLD)=SDNAME D
. . S SDARY(SDFLD)=""
Q
;
DELDD(SDD) ; -- tool to delete fields dd
; -- delete dd
N SDI,SDX,SDENDFLG,SDCNT
S SDENDFLG="$$END$$"
S SDCNT=0
;
; -- delete dds
F SDI=1:1 S SDX=$P($T(FLDS+SDI),";;",2) Q:SDX=SDENDFLG D
. N SDFILE,SDFLD,SDNAME
. S SDFILE=+SDX
. S SDFLD=+$P(SDX,U,2)
. S SDNAME=$P(SDX,U,3)
. ;
. ; -- make sure field is not reused before deleting
. IF SDD=SDFILE,$$LABEL(SDFILE,SDFLD)=SDNAME D
. . N DIK,DA
. . S DIK="^DD("_SDD_",",DA=SDFLD,DA(1)=SDD D ^DIK
. . D MSG(SDFLD,SDNAME)
. . S SDCNT=SDCNT+1
;
IF 'SDCNT D MES^XPDUTL(" -> Fields already deleted.")
Q
;
LABEL(SDFILE,SDFLD) ; -- get label if not deleted
N SDY
D FIELD^DID(SDFILE,SDFLD,"N","LABEL","SDY")
Q $G(SDY("LABEL"))
;
MSG(SDFLD,SDNAME) ; -- tell user (use kids call??)
D MES^XPDUTL(" -> Field '"_SDFLD_" - "_SDNAME_"' deleted.")
Q
;
FLDS ; -- fields to be deleted [ file# ^ field# ^ field label ]
;;43^201^SPEC SURVEY DISP LAST RUN
;;43^202^OPC FILE LAST RUN
;;43^203^OPC TRANSMISSION LAST RUN
;;43^204^GENERATING OPC FILE NOW?
;;43^206^AMB PROC INITIALIZATION DATE
;;43^206.1^OPC VLR DATE
;;43^206.2^OPC MT INCOME DATE
;;43^207^OPC STOP CODE CONVERSION DATE
;;43^208^OPC GENERATION START DATE
;;43^209^OPC GENERATION END DATE
;;43^214^GEN OPC W/APPT STATUS UPDATE
;;43^221^STOP CODE MAIL GROUP
;;43^218^OPC FY93 FORMAT DATE
;;43^219^ASK PROVIDER ON DISPOSITION
;;43^220^ASK DIAGNOSIS ON DISPOSITION
;;43^222^OPC FY94 FORMAT DATE
;;43^225^OPC FY95 FORMAT DATE
;;44^25^PROCEDURE CHECK-OFF SHEET
;;44^26^ASK PROVIDER AT CHECK OUT
;;44^27^ASK DIAGNOSIS AT CHECK OUT
;;44^28^ASK STOP CODES AT CHECK OUT
;;409.65^.06^OPC LAST GENERATED
;;409.65^.07^OPC LAST TRANSMITTED
;;409.65^.08^OPC LAST GENERATED BY
;;409.65^.09^OPC LAST TRANSMITTED BY
;;$$END$$
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD132PT 7579 printed Dec 13, 2024@02:44:36 Page 2
SD132PT ;ALB/MJK - Patch SD*5.3*132 Post-Init Routine ; 11/5/97
+1 ;;5.3;Scheduling;**132**;Aug 13, 1993
+2 ;
EN ; --- main entry point
+1 SET U="^"
+2 DO BMES^XPDUTL("Post-Init Started...")
+3 ;
+4 ; -- main driver calls
+5 DO MAS
DO HL
DO LOG
DO ACG
DO AG
DO OVER
+6 ;
+7 DO BMES^XPDUTL("Post-Init Finished.")
+8 QUIT
+9 ;
MAS ; -- delete MAS PARAMETERS (#43) fields and related data
+1 NEW SDARY
+2 ;
+3 DO BMES^XPDUTL(" >>> Deleting MAS PARAMETERS (#43) fields...")
+4 ;
+5 ; -- get fields to delete
+6 DO BUILDR(43,.SDARY)
+7 ;
+8 IF '$ORDER(SDARY(0))
GOTO MASQ
+9 ;
+10 ; -- delete data
+11 NEW SDFDA,SDFLD
+12 SET SDFLD=0
+13 FOR
SET SDFLD=$ORDER(SDARY(SDFLD))
if 'SDFLD
QUIT
Begin DoDot:1
+14 SET SDFDA(43,"1,",SDFLD)="@"
End DoDot:1
+15 DO FILE^DIE("S","SDFDA")
+16 ;
+17 ; -- delete dds
+18 DO DELDD(43)
MASQ DO MES^XPDUTL(" >>> Done.")
+1 QUIT
+2 ;
HL ; -- delete HOSPITIAL LOCATION (#44) fields and related data
+1 NEW SDARY
+2 ;
+3 DO BMES^XPDUTL(" >>> Deleting HOSPITAL LOCATION (#44) fields...")
+4 ;
+5 ; -- get fields to delete
+6 DO BUILDR(44,.SDARY)
+7 ;
+8 IF '$ORDER(SDARY(0))
GOTO HLQ
+9 ;
+10 ; -- delete data
+11 SET SDIEN=0
+12 FOR
SET SDIEN=$ORDER(^SC(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+13 NEW SDFDA,SDFLD
+14 SET SDFLD=0
+15 FOR
SET SDFLD=$ORDER(SDARY(SDFLD))
if 'SDFLD
QUIT
Begin DoDot:2
+16 SET SDFDA(44,SDIEN_",",SDFLD)="@"
End DoDot:2
+17 DO FILE^DIE("S","SDFDA")
End DoDot:1
+18 ;
+19 ; -- delete dds
+20 DO DELDD(44)
HLQ DO MES^XPDUTL(" >>> Done.")
+1 QUIT
+2 ;
LOG ; -- delete APPOINTMENT STATUS UPDATE LOG (#409.65) fields and related data
+1 NEW SDARY
+2 ;
+3 DO BMES^XPDUTL(" >>> Deleting APPPOINT STATUS UPDATE LOG (409.65) fields...")
+4 ;
+5 ; -- get fields to delete
+6 DO BUILDR(409.65,.SDARY)
+7 ;
+8 IF '$ORDER(SDARY(0))
GOTO LOGQ
+9 ;
+10 ; -- delete data
+11 SET SDIEN=0
+12 FOR
SET SDIEN=$ORDER(^SDD(409.65,SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+13 NEW SDFDA,SDFLD
+14 SET SDFLD=0
+15 FOR
SET SDFLD=$ORDER(SDARY(SDFLD))
if 'SDFLD
QUIT
Begin DoDot:2
+16 SET SDFDA(409.65,SDIEN_",",SDFLD)="@"
End DoDot:2
+17 DO FILE^DIE("S","SDFDA")
End DoDot:1
+18 ;
+19 ; -- delete dds
+20 DO DELDD(409.65)
LOGQ DO MES^XPDUTL(" >>> Done.")
+1 QUIT
+2 ;
ACG ; -- update new computer generated appt type related fields in
+1 ; OUTPATIENT ENCOUNTER (#409.68) with data for ^SDV data
+2 ;
+3 DO BMES^XPDUTL(" >>> Setting 'ACG' cross references...")
+4 ;
+5 ; -- scan ^SDV("ACG") for records
+6 NEW SDATE,SDCS,SDCS0,SDOE,SDOE0,SDREASON,SDAPPT,SDCG,DR,DA,DIE
+7 SET SDATE=0
+8 FOR
SET SDATE=$ORDER(^SDV("ACG",SDATE))
if 'SDATE
QUIT
Begin DoDot:1
+9 SET SDCS=0
FOR
SET SDCS=$ORDER(^SDV("ACG",SDATE,SDCS))
if 'SDCS
QUIT
Begin DoDot:2
+10 SET SDCS0=$GET(^SDV(SDATE,"CS",SDCS,0))
+11 SET SDCG=+$GET(^SDV(SDATE,"CS",SDCS,1))
+12 SET SDAPPT=$PIECE(SDCS0,U,5)
+13 SET SDREASON=$PIECE(SDCS0,U,6)
+14 SET SDOE=+$PIECE(SDCS0,U,8)
+15 SET SDOE0=$GET(^SCE(SDOE,0))
+16 IF SDAPPT=10
IF SDOE
IF $PIECE(SDOE0,U,10)=10
IF $GET(^SCE(SDOE,"CG"))=""
Begin DoDot:3
+17 SET DR=".1////10"
+18 IF SDCG
SET DR=DR_";201////1"
+19 IF SDREASON
SET DR=DR_";202////"_SDREASON
+20 SET DIE="^SCE("
SET DA=SDOE
DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 DO MES^XPDUTL(" >>> Done.")
+23 QUIT
+24 ;
AG ; -- queue job to set 'AG' xref and related fields
+1 NEW SDUZ,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSAVE,ZTSK
+2 SET SDUZ=$GET(DUZ)
+3 DO BMES^XPDUTL(" >>> Queuing task to set 'AG' cross reference.")
+4 ; -- disable option
+5 DO OUT^XPDMENU("SDACS CGSCLIST","AG Cross Reference Being Set")
+6 DO MES^XPDUTL(" -> Option 'SDACS CGSCLIST' has been placed out of service.")
+7 ;
+8 ; -- queue task
+9 SET ZTIO=""
+10 SET ZTRTN="AGQUE^SD132PT"
+11 SET ZTDESC="Setting 'AG' Cross Reference"
+12 SET ZTDTH=$$NOW^XLFDT()
+13 FOR X="SDUZ"
SET ZTSAVE(X)=""
+14 DO ^%ZTLOAD
+15 if $DATA(ZTSK)
DO MES^XPDUTL(" -> Task: #"_ZTSK)
+16 DO MES^XPDUTL(" >>> Done.")
+17 QUIT
+18 ;
AGQUE ; -- TaskMan entry point to queue 'AG' setting
+1 ;
+2 NEW SDATE,SDCS,SDCS0,SDOE,SDREASON,SDCG,DR,DA,DIE,SDSTOP,SDTOT,SDBEG,SDEND
+3 ;
+4 SET SDTOT=0
+5 SET SDBEG=$$NOW^XLFDT()
+6 ;
+7 ; -- scan ^SDV("AG") for records
+8 SET SDATE=0
+9 FOR
SET SDATE=$ORDER(^SDV("AG",SDATE))
if 'SDATE
QUIT
Begin DoDot:1
+10 SET SDCS=0
FOR
SET SDCS=$ORDER(^SDV("AG",SDATE,SDCS))
if 'SDCS
QUIT
Begin DoDot:2
+11 SET SDCS0=$GET(^SDV(SDATE,"CS",SDCS,0))
+12 SET SDCG=+$GET(^SDV(SDATE,"CS",SDCS,1))
+13 SET SDOE=+$PIECE(SDCS0,U,8)
+14 SET SDREASON=$PIECE(SDCS0,U,6)
+15 IF SDOE
IF $GET(^SCE(SDOE,0))]""
IF $GET(^SCE(SDOE,"CG"))=""
IF SDCG
Begin DoDot:3
+16 SET DR="201////1"
+17 IF SDREASON
SET DR=DR_";202////"_SDREASON
+18 SET DIE="^SCE("
SET DA=SDOE
DO ^DIE
+19 SET SDTOT=SDTOT+1
End DoDot:3
End DoDot:2
End DoDot:1
SET SDSTOP=$$S^%ZTLOAD
if SDSTOP
QUIT
+20 ;
+21 SET SDEND=$$NOW^XLFDT()
+22 ; -- send bulletin and enable option
+23 DO BULL
+24 QUIT
+25 ;
BULL ; -- send message indicating 'AG' xref is set and option enabled
+1 NEW SDTEXT,SDCNT,XMSUB,XMN,XMTEXT,XMDUZ,XMY
+2 SET SDCNT=0
+3 ;
+4 DO LINE("")
+5 DO LINE(" >>> Task Started: "_$$FMTE^XLFDT(SDBEG))
+6 DO LINE(" Finished: "_$$FMTE^XLFDT(SDEND))
+7 DO LINE("")
+8 ;
+9 ; -- build text
+10 IF SDSTOP
Begin DoDot:1
+11 DO LINE(" >>> Task stopped by user. <<<")
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 ; -- enable option
+14 DO OUT^XPDMENU("SDACS CGSCLIST","")
+15 ;
+16 ; -- build text
+17 DO LINE(" >>> Task Completed.")
+18 DO LINE("")
+19 DO LINE(" >>> Option 'SDACS CGSCLIST' is back in service.")
End DoDot:1
+20 ;
+21 DO LINE("")
+22 DO LINE(" >>> "_SDTOT_" Records processed.")
+23 ; -- set xm vars and send message
+24 SET XMSUB="Setting of 'AG' Cross Reference Task Information"
+25 SET XMN=0
+26 SET XMTEXT="SDTEXT("
+27 SET XMDUZ=.5
+28 SET XMY(SDUZ)=""
+29 DO ^XMD
+30 QUIT
+31 ;
OVER ; -- post override flag information
+1 NEW SDPKG,SDCNT
+2 ;
+3 DO BMES^XPDUTL(" >>> Package Override Flag Information")
+4 ;
+5 SET SDPKG="A"
SET SDCNT=0
+6 FOR
SET SDPKG=$ORDER(^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG))
if SDPKG=""
QUIT
Begin DoDot:1
+7 DO MES^XPDUTL(" -> Override flag set for '"_SDPKG_"'")
+8 SET SDCNT=SDCNT+1
End DoDot:1
+9 ;
+10 IF 'SDCNT
DO MES^XPDUTL(" -> No package override flags set.")
+11 DO MES^XPDUTL(" >>> Done.")
+12 QUIT
+13 ;
LINE(TEXT) ; -- add line of text
+1 SET SDCNT=SDCNT+1
+2 SET SDTEXT(SDCNT)=TEXT
+3 QUIT
+4 ;
BUILDR(SDD,SDARY) ; -- build array of fields to delete
+1 NEW SDI,SDX,SDENDFLG
+2 SET SDENDFLG="$$END$$"
+3 ;
+4 FOR SDI=1:1
SET SDX=$PIECE($TEXT(FLDS+SDI),";;",2)
if SDX=SDENDFLG
QUIT
Begin DoDot:1
+5 NEW SDFILE,SDFLD
+6 SET SDFILE=+SDX
+7 SET SDFLD=+$PIECE(SDX,U,2)
+8 SET SDNAME=$PIECE(SDX,U,3)
+9 IF SDD=SDFILE
IF $$LABEL(SDFILE,SDFLD)=SDNAME
Begin DoDot:2
+10 SET SDARY(SDFLD)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
DELDD(SDD) ; -- tool to delete fields dd
+1 ; -- delete dd
+2 NEW SDI,SDX,SDENDFLG,SDCNT
+3 SET SDENDFLG="$$END$$"
+4 SET SDCNT=0
+5 ;
+6 ; -- delete dds
+7 FOR SDI=1:1
SET SDX=$PIECE($TEXT(FLDS+SDI),";;",2)
if SDX=SDENDFLG
QUIT
Begin DoDot:1
+8 NEW SDFILE,SDFLD,SDNAME
+9 SET SDFILE=+SDX
+10 SET SDFLD=+$PIECE(SDX,U,2)
+11 SET SDNAME=$PIECE(SDX,U,3)
+12 ;
+13 ; -- make sure field is not reused before deleting
+14 IF SDD=SDFILE
IF $$LABEL(SDFILE,SDFLD)=SDNAME
Begin DoDot:2
+15 NEW DIK,DA
+16 SET DIK="^DD("_SDD_","
SET DA=SDFLD
SET DA(1)=SDD
DO ^DIK
+17 DO MSG(SDFLD,SDNAME)
+18 SET SDCNT=SDCNT+1
End DoDot:2
End DoDot:1
+19 ;
+20 IF 'SDCNT
DO MES^XPDUTL(" -> Fields already deleted.")
+21 QUIT
+22 ;
LABEL(SDFILE,SDFLD) ; -- get label if not deleted
+1 NEW SDY
+2 DO FIELD^DID(SDFILE,SDFLD,"N","LABEL","SDY")
+3 QUIT $GET(SDY("LABEL"))
+4 ;
MSG(SDFLD,SDNAME) ; -- tell user (use kids call??)
+1 DO MES^XPDUTL(" -> Field '"_SDFLD_" - "_SDNAME_"' deleted.")
+2 QUIT
+3 ;
FLDS ; -- fields to be deleted [ file# ^ field# ^ field label ]
+1 ;;43^201^SPEC SURVEY DISP LAST RUN
+2 ;;43^202^OPC FILE LAST RUN
+3 ;;43^203^OPC TRANSMISSION LAST RUN
+4 ;;43^204^GENERATING OPC FILE NOW?
+5 ;;43^206^AMB PROC INITIALIZATION DATE
+6 ;;43^206.1^OPC VLR DATE
+7 ;;43^206.2^OPC MT INCOME DATE
+8 ;;43^207^OPC STOP CODE CONVERSION DATE
+9 ;;43^208^OPC GENERATION START DATE
+10 ;;43^209^OPC GENERATION END DATE
+11 ;;43^214^GEN OPC W/APPT STATUS UPDATE
+12 ;;43^221^STOP CODE MAIL GROUP
+13 ;;43^218^OPC FY93 FORMAT DATE
+14 ;;43^219^ASK PROVIDER ON DISPOSITION
+15 ;;43^220^ASK DIAGNOSIS ON DISPOSITION
+16 ;;43^222^OPC FY94 FORMAT DATE
+17 ;;43^225^OPC FY95 FORMAT DATE
+18 ;;44^25^PROCEDURE CHECK-OFF SHEET
+19 ;;44^26^ASK PROVIDER AT CHECK OUT
+20 ;;44^27^ASK DIAGNOSIS AT CHECK OUT
+21 ;;44^28^ASK STOP CODES AT CHECK OUT
+22 ;;409.65^.06^OPC LAST GENERATED
+23 ;;409.65^.07^OPC LAST TRANSMITTED
+24 ;;409.65^.08^OPC LAST GENERATED BY
+25 ;;409.65^.09^OPC LAST TRANSMITTED BY
+26 ;;$$END$$
