PRSXP105 ;WCIOFO/RRG-CORRECT VCS ALLOTMENT ;11/18/2005
;;4.0;PAID;**105**;Sep 21, 1995
;
;
Q
;
;
READ ; This module will run as a post install for *105
; It will update the read access value and the
; 'Date Last Updated' for 4 fields in #450
;
F I=758,759,760,761 S ^DD(450,I,8)="FP",^DD(450,I,"DT")=DT
Q
;
;
; The remainder of this program will correct the formatting
; for the following fields:
;
; PAID EMPLOYEE (#450)
; #586.1 - VCS ALLOTMENT AMT
;
; PAID PAYRUN DATA (#459)
; #171 - VCS ALLOTMENT AMT
;
DEVICE ;Ask device or queue
;
;
W ! K IOP,%ZIS
S %ZIS("A")="Select Device: ",%ZIS="MQ"
D ^%ZIS K %ZIS,IOP
Q:POP
;
I $D(IO("Q")) D Q
. S PRSAPGM="START^PRSXP105",XQY0="CORRECT VCS ALLOTTMENT FIELDS",PRSALST=""
. D QUE^PRSAUTL
. K PRSAPGM,XQY0,PRSALST,POP
;
;
START ; Main Driver
;
D 450
D 459
I $D(^TMP($J,"LOCKED","P105")) D WARN
Q
;
450 ; Correct data in the PAID EMPLOYEE (#450) file
;
N CNT,DA,DATA,DIE,DR,EMP,LCNT,LINE,LINE2,MESS,MSG,MSG1,LKCNT
N NAME,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK"
K ^TMP($J)
S MESS="PAID EMPLOYEE (#450)",MSG1=" beginning at "
D TIME
D STAUCI
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S MESS="Correcting the VCS ALLOTMENT AMT (#586.1) field."
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)=LINE2,LCNT=LCNT+1
S MESS=" CURRENT CORRECTED"
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
S MESS="PAID EMPLOYEE (#450) VALUE VALUE"
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
;
;
S (EMP,CNT)=0,LKCNT=1,FILE=450
F S EMP=$O(^PRSPC(EMP)) Q:'EMP D
. S DATA=$$GET1^DIQ(450,EMP,586.1)
. Q:DATA="" ; Quit if they don't have any VCS Allotment
. ; Quit if the value has already been formatted by another download
. Q:DATA["."
. D NAME
. L +^PRSPC(EMP):0
. I '$T D LOCKED Q
. S PVAL=DATA ; Previous value
. D DD^PRSDUTIL
. S DR="586.1///^S X=DATA",DA=EMP,DIE=450
. D ^DIE
. L -^PRSPC(EMP)
. S CNT=CNT+1
. S MESS=NAME,$E(MESS,31,35)=PVAL,$E(MESS,40,46)=DATA
. S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S MESS=$S(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
I STATUS="Check" D
. S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
. S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S MESS="PAID EMPLOYEE (#450)",MSG1=" ending at "
D TIME
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S STATUS="OK",MSG=MSG_"450 "_STATUS
D XMT
Q
;
;
459 ; Correct data in the PAID PAYRUN DATA (#459) file
;
N CNT,DATA,EMP,I,IENS,LCNT,LINE,MESS,MSG
N NAME,PPE,PPI,PPIEN,PRSFDA,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK",FILE=459
K ^TMP($J,"P105")
S MESS="PAID PAYRUN DATA (#459)",MSG1=" beginning at "
D TIME
D STAUCI
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S MESS="Correcting the VCS ALLOTMENT AMT (#171) field of the"
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
S MESS="EMPLOYEE (#459.01) multiple."
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S PPI="03-10"
F S PPIEN="",PPI=$O(^PRST(459,"B",PPI)) Q:'PPI!(PPI>"07-20") D
. S PPIEN=$O(^PRST(459,"B",PPI,0)) Q:'PPIEN
. S PPE=$P(^PRST(459,PPIEN,0),"^")
. S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)="Pay Period "_PPE,LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)=LINE2,LCNT=LCNT+1
. S MESS=" CURRENT CORRECTED"
. S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
. S MESS="PAID PAYRUN DATA (#459) VALUE VALUE"
. S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
. S (CNT,EMP)=0
. F S EMP=$O(^PRST(459,PPIEN,"P",EMP)) Q:'EMP D
. . S IENS=EMP_","_PPIEN_","
. . S DATA=$$GET1^DIQ(459.01,IENS,171)
. . Q:DATA="" ; Quit if they don't have any VCS Allotment
. . ; Quit if the value has already been formatted by another download
. . Q:DATA["."
. . D NAME
. . L +^PRST(459,PPIEN,"P",EMP):0
. . I '$T D LOCKED Q
. . S PVAL=DATA
. . D DD^PRSDUTIL
. . S IENS=EMP_","_PPIEN_",",PRSFDA(459.01,IENS,171)=DATA
. . D FILE^DIE("","PRSFDA") ; Correct data
. . S CNT=CNT+1
. . L -^PRST(459,PPIEN,"P",EMP)
. . S $E(NAME,1,$L(TNAME))=TNAME,$E(NAME,31,35)=PVAL,$E(NAME,40,46)=DATA
. . S ^TMP($J,"P105",LCNT)=NAME,LCNT=LCNT+1
. S MESS=$S(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
. S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
. S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
. I STATUS="Check" D
. . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
. . S ^TMP($J,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
. . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
S MESS="PAID PAYRUN DATA (#459)",MSG1=" ending at "
D TIME
S STATUS="OK",MSG=MSG_"459 "_STATUS
D XMT
Q
;
XMT ; Send status via mail message
;
I $D(^TMP($J,"P105")) D
. N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
. S XMDUZ=.5
. S XMSUB=MSG
. S XMTEXT="^TMP($J,""P105"","
. S XMY(DUZ)=""
. S XMY("G.PAD@"_^XMB("NETNAME"))=""
. D ^XMD
;
K ^TMP($J,"P105"),Y,%
Q
;
TIME ; Get current Time
;
D NOW^%DTC
S Y=%
D DD^%DT
S TIME=Y
S MESS=MESS_" clean up routine"_MSG1_TIME_"."
S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
Q
;
; Get Station Number
;
STAUCI S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MSG=STANUM_" - "
;
; Check for UCI,VOL
;
X ^%ZOSF("UCI")
S UCIX=$G(Y)
I UCIX="" S UCIX="??????"
S MSG=MSG_UCIX_" - "
Q
;
NAME ; Format name
;
S NAME="",$P(NAME," ",30)=""
S TNAME=$$GET1^DIQ(450,EMP,.01)
I TNAME="" S TNAME=EMP
S $E(NAME,1,$L(TNAME))=TNAME
Q
;
LOCKED ; Message for locked records
;
S MESS=NAME_" record was locked in file # "_FILE
S ^TMP($J,"LOCKED","P105",LKCNT)=MESS,LKCNT=LKCNT+1
S STATUS="Check"
Q
;
WARN ; Warning message if records were locked
;
S ^TMP($J,"LOCKED","P105",LKCNT)="",LKCNT=LKCNT+1
S ^TMP($J,"LOCKED","P105",LKCNT)="These records were locked.",LKCNT=LKCNT+1
S ^TMP($J,"LOCKED","P105",LKCNT)="Contact NVS @ 888-596-4357",LKCNT=LKCNT+1
;
I $D(^TMP($J,"LOCKED","P105")) D
. N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
. S XMDUZ=.5
. S XMSUB="Locked records - PRS*4*105"
. S XMTEXT="^TMP($J,""LOCKED"",""P105"","
. S XMY(DUZ)=""
. S XMY("G.PAD@"_^XMB("NETNAME"))=""
. D ^XMD
;
K ^TMP($J,"LOCKED","P105"),Y,%
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP105 6860 printed Nov 22, 2024@17:38:48 Page 2
PRSXP105 ;WCIOFO/RRG-CORRECT VCS ALLOTMENT ;11/18/2005
+1 ;;4.0;PAID;**105**;Sep 21, 1995
+2 ;
+3 ;
+4 QUIT
+5 ;
+6 ;
READ ; This module will run as a post install for *105
+1 ; It will update the read access value and the
+2 ; 'Date Last Updated' for 4 fields in #450
+3 ;
+4 FOR I=758,759,760,761
SET ^DD(450,I,8)="FP"
SET ^DD(450,I,"DT")=DT
+5 QUIT
+6 ;
+7 ;
+8 ; The remainder of this program will correct the formatting
+9 ; for the following fields:
+10 ;
+11 ; PAID EMPLOYEE (#450)
+12 ; #586.1 - VCS ALLOTMENT AMT
+13 ;
+14 ; PAID PAYRUN DATA (#459)
+15 ; #171 - VCS ALLOTMENT AMT
+16 ;
DEVICE ;Ask device or queue
+1 ;
+2 ;
+3 WRITE !
KILL IOP,%ZIS
+4 SET %ZIS("A")="Select Device: "
SET %ZIS="MQ"
+5 DO ^%ZIS
KILL %ZIS,IOP
+6 if POP
QUIT
+7 ;
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET PRSAPGM="START^PRSXP105"
SET XQY0="CORRECT VCS ALLOTTMENT FIELDS"
SET PRSALST=""
+10 DO QUE^PRSAUTL
+11 KILL PRSAPGM,XQY0,PRSALST,POP
End DoDot:1
QUIT
+12 ;
+13 ;
START ; Main Driver
+1 ;
+2 DO 450
+3 DO 459
+4 IF $DATA(^TMP($JOB,"LOCKED","P105"))
DO WARN
+5 QUIT
+6 ;
450 ; Correct data in the PAID EMPLOYEE (#450) file
+1 ;
+2 NEW CNT,DA,DATA,DIE,DR,EMP,LCNT,LINE,LINE2,MESS,MSG,MSG1,LKCNT
+3 NEW NAME,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
+4 SET U="^"
SET LCNT=1
SET $PIECE(LINE,"-",80)=""
SET $PIECE(LINE2,"=",80)=""
SET STATUS="OK"
+5 KILL ^TMP($JOB)
+6 SET MESS="PAID EMPLOYEE (#450)"
SET MSG1=" beginning at "
+7 DO TIME
+8 DO STAUCI
+9 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+10 SET MESS="Correcting the VCS ALLOTMENT AMT (#586.1) field."
+11 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+12 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+13 SET ^TMP($JOB,"P105",LCNT)=LINE2
SET LCNT=LCNT+1
+14 SET MESS=" CURRENT CORRECTED"
+15 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+16 SET MESS="PAID EMPLOYEE (#450) VALUE VALUE"
+17 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+18 SET ^TMP($JOB,"P105",LCNT)=LINE
SET LCNT=LCNT+1
+19 ;
+20 ;
+21 SET (EMP,CNT)=0
SET LKCNT=1
SET FILE=450
+22 FOR
SET EMP=$ORDER(^PRSPC(EMP))
if 'EMP
QUIT
Begin DoDot:1
+23 SET DATA=$$GET1^DIQ(450,EMP,586.1)
+24 ; Quit if they don't have any VCS Allotment
if DATA=""
QUIT
+25 ; Quit if the value has already been formatted by another download
+26 if DATA["."
QUIT
+27 DO NAME
+28 LOCK +^PRSPC(EMP):0
+29 IF '$TEST
DO LOCKED
QUIT
+30 ; Previous value
SET PVAL=DATA
+31 DO DD^PRSDUTIL
+32 SET DR="586.1///^S X=DATA"
SET DA=EMP
SET DIE=450
+33 DO ^DIE
+34 LOCK -^PRSPC(EMP)
+35 SET CNT=CNT+1
+36 SET MESS=NAME
SET $EXTRACT(MESS,31,35)=PVAL
SET $EXTRACT(MESS,40,46)=DATA
+37 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
End DoDot:1
+38 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+39 SET ^TMP($JOB,"P105",LCNT)=LINE
SET LCNT=LCNT+1
+40 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+41 SET MESS=$SELECT(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
+42 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+43 IF STATUS="Check"
Begin DoDot:1
+44 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+45 SET ^TMP($JOB,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
+46 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
End DoDot:1
+47 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+48 SET MESS="PAID EMPLOYEE (#450)"
SET MSG1=" ending at "
+49 DO TIME
+50 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+51 SET STATUS="OK"
SET MSG=MSG_"450 "_STATUS
+52 DO XMT
+53 QUIT
+54 ;
+55 ;
459 ; Correct data in the PAID PAYRUN DATA (#459) file
+1 ;
+2 NEW CNT,DATA,EMP,I,IENS,LCNT,LINE,MESS,MSG
+3 NEW NAME,PPE,PPI,PPIEN,PRSFDA,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
+4 SET U="^"
SET LCNT=1
SET $PIECE(LINE,"-",80)=""
SET $PIECE(LINE2,"=",80)=""
SET STATUS="OK"
SET FILE=459
+5 KILL ^TMP($JOB,"P105")
+6 SET MESS="PAID PAYRUN DATA (#459)"
SET MSG1=" beginning at "
+7 DO TIME
+8 DO STAUCI
+9 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+10 SET MESS="Correcting the VCS ALLOTMENT AMT (#171) field of the"
+11 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+12 SET MESS="EMPLOYEE (#459.01) multiple."
+13 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+14 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+15 SET PPI="03-10"
+16 FOR
SET PPIEN=""
SET PPI=$ORDER(^PRST(459,"B",PPI))
if 'PPI!(PPI>"07-20")
QUIT
Begin DoDot:1
+17 SET PPIEN=$ORDER(^PRST(459,"B",PPI,0))
if 'PPIEN
QUIT
+18 SET PPE=$PIECE(^PRST(459,PPIEN,0),"^")
+19 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+20 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+21 SET ^TMP($JOB,"P105",LCNT)="Pay Period "_PPE
SET LCNT=LCNT+1
+22 SET ^TMP($JOB,"P105",LCNT)=LINE2
SET LCNT=LCNT+1
+23 SET MESS=" CURRENT CORRECTED"
+24 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+25 SET MESS="PAID PAYRUN DATA (#459) VALUE VALUE"
+26 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+27 SET ^TMP($JOB,"P105",LCNT)=LINE
SET LCNT=LCNT+1
+28 SET (CNT,EMP)=0
+29 FOR
SET EMP=$ORDER(^PRST(459,PPIEN,"P",EMP))
if 'EMP
QUIT
Begin DoDot:2
+30 SET IENS=EMP_","_PPIEN_","
+31 SET DATA=$$GET1^DIQ(459.01,IENS,171)
+32 ; Quit if they don't have any VCS Allotment
if DATA=""
QUIT
+33 ; Quit if the value has already been formatted by another download
+34 if DATA["."
QUIT
+35 DO NAME
+36 LOCK +^PRST(459,PPIEN,"P",EMP):0
+37 IF '$TEST
DO LOCKED
QUIT
+38 SET PVAL=DATA
+39 DO DD^PRSDUTIL
+40 SET IENS=EMP_","_PPIEN_","
SET PRSFDA(459.01,IENS,171)=DATA
+41 ; Correct data
DO FILE^DIE("","PRSFDA")
+42 SET CNT=CNT+1
+43 LOCK -^PRST(459,PPIEN,"P",EMP)
+44 SET $EXTRACT(NAME,1,$LENGTH(TNAME))=TNAME
SET $EXTRACT(NAME,31,35)=PVAL
SET $EXTRACT(NAME,40,46)=DATA
+45 SET ^TMP($JOB,"P105",LCNT)=NAME
SET LCNT=LCNT+1
End DoDot:2
+46 SET MESS=$SELECT(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
+47 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+48 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+49 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+50 IF STATUS="Check"
Begin DoDot:2
+51 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
+52 SET ^TMP($JOB,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
+53 SET ^TMP($JOB,"P105",LCNT)=""
SET LCNT=LCNT+1
End DoDot:2
End DoDot:1
+54 SET MESS="PAID PAYRUN DATA (#459)"
SET MSG1=" ending at "
+55 DO TIME
+56 SET STATUS="OK"
SET MSG=MSG_"459 "_STATUS
+57 DO XMT
+58 QUIT
+59 ;
XMT ; Send status via mail message
+1 ;
+2 IF $DATA(^TMP($JOB,"P105"))
Begin DoDot:1
+3 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+4 SET XMDUZ=.5
+5 SET XMSUB=MSG
+6 SET XMTEXT="^TMP($J,""P105"","
+7 SET XMY(DUZ)=""
+8 SET XMY("G.PAD@"_^XMB("NETNAME"))=""
+9 DO ^XMD
End DoDot:1
+10 ;
+11 KILL ^TMP($JOB,"P105"),Y,%
+12 QUIT
+13 ;
TIME ; Get current Time
+1 ;
+2 DO NOW^%DTC
+3 SET Y=%
+4 DO DD^%DT
+5 SET TIME=Y
+6 SET MESS=MESS_" clean up routine"_MSG1_TIME_"."
+7 SET ^TMP($JOB,"P105",LCNT)=MESS
SET LCNT=LCNT+1
+8 QUIT
+9 ;
+10 ; Get Station Number
+11 ;
STAUCI SET STANUM=$$KSP^XUPARAM("INST")_","
+1 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+2 SET MSG=STANUM_" - "
+3 ;
+4 ; Check for UCI,VOL
+5 ;
+6 XECUTE ^%ZOSF("UCI")
+7 SET UCIX=$GET(Y)
+8 IF UCIX=""
SET UCIX="??????"
+9 SET MSG=MSG_UCIX_" - "
+10 QUIT
+11 ;
NAME ; Format name
+1 ;
+2 SET NAME=""
SET $PIECE(NAME," ",30)=""
+3 SET TNAME=$$GET1^DIQ(450,EMP,.01)
+4 IF TNAME=""
SET TNAME=EMP
+5 SET $EXTRACT(NAME,1,$LENGTH(TNAME))=TNAME
+6 QUIT
+7 ;
LOCKED ; Message for locked records
+1 ;
+2 SET MESS=NAME_" record was locked in file # "_FILE
+3 SET ^TMP($JOB,"LOCKED","P105",LKCNT)=MESS
SET LKCNT=LKCNT+1
+4 SET STATUS="Check"
+5 QUIT
+6 ;
WARN ; Warning message if records were locked
+1 ;
+2 SET ^TMP($JOB,"LOCKED","P105",LKCNT)=""
SET LKCNT=LKCNT+1
+3 SET ^TMP($JOB,"LOCKED","P105",LKCNT)="These records were locked."
SET LKCNT=LKCNT+1
+4 SET ^TMP($JOB,"LOCKED","P105",LKCNT)="Contact NVS @ 888-596-4357"
SET LKCNT=LKCNT+1
+5 ;
+6 IF $DATA(^TMP($JOB,"LOCKED","P105"))
Begin DoDot:1
+7 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+8 SET XMDUZ=.5
+9 SET XMSUB="Locked records - PRS*4*105"
+10 SET XMTEXT="^TMP($J,""LOCKED"",""P105"","
+11 SET XMY(DUZ)=""
+12 SET XMY("G.PAD@"_^XMB("NETNAME"))=""
+13 DO ^XMD
End DoDot:1
+14 ;
+15 KILL ^TMP($JOB,"LOCKED","P105"),Y,%
+16 QUIT
+17 ;
