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

PRCFDLN.m

Go to the documentation of this file.
  1. PRCFDLN ;WISC@ALTOONA/CTB-CREATE NEXT DOCUMENT LOCATOR NUMBER ;27 Feb 90/11:39 AM
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;CREATE DOCUMENT LOCATOR NUMBER FOR CERTIFIED INVOICE
  1. ;REQUIRES PRCFX("X")=DATE,PRC("SITE")=STATION NUMBER
  1. ;IF PRCFX("X") IS UNDEFINED, OR NOT ?7N PROGRAM WILL ASSUME CURRENT DATE
  1. I $S($D(PRC("SITE"))["0":1,+PRC("SITE")=0:1,1:0) S X=" Station Number is undefined, Processing is terminated.*" D MSG^PRCFQ S %=0 Q
  1. I $S($D(PRCFX("X"))[0:1,PRCFX("X")?7N:1,1:0) D NOW^PRCFQ S PRCFX("X")=X S:$D(DT)[0 DT=X K %,%X,X,Y
  1. S X=PRCFX("X") D JD S PRCFDLN=Y,X=PRC("SITE")_"-DLN-"_X D DLN
  1. S PRCFDLN=PRCFDLN_"7"_PRC("SITE")_Y K Y,%Y,DA Q
  1. JD ;CREATE JULIAN DATE FROM FM INTERNAL DATE
  1. ;REQUIRES X=FM INTERNAL DATE. RETURN Y AS JULIAN DAY NUMBER
  1. N DAY,DAYS,MO,YR,I,Z
  1. S Y=-1,DAYS="31^28^31^30^31^30^31^31^30^31^30^31"
  1. S YR=$E(X,1,3)+1700,MO=+$E(X,4,5),DAY=+$E(X,6,7)
  1. I (YR#4=0)&((YR#100)!(YR#400=0)) S $P(DAYS,"^",2)=29
  1. S Z=0 F I=1:1:MO-1 Q:MO=I S Z=Z+$P(DAYS,"^",I)
  1. S Y=Z+DAY,Y="000"_Y,Y=$E(Y,$L(Y)-2,$L(Y)),Y=Y_$E(YR,4) Q
  1. DLN ;GET NEXT SEQUENCE NUMBER FOR JULIAN DATE
  1. ;REQUIRES X=PRC("SITE")_"-"_JULIAN DATE. JD must be in fromat dddy where ddd is Julian day and y is last character of year.
  1. ;returns next julian date for the number in Y where Y=+Y
  1. D NEXT Q:Y<0
  1. S Y="000"_Y,Y=$E(Y,$L(Y)-2,$L(Y)),%=1 Q
  1. NEXT N PRCFX,K S K=0,Y=$O(^PRCF(421.7,"B",X,0))
  1. I Y="" S DIC=421.7,DIC(0)="XL",DLAYGO=DIC D ^DIC S %=0 K DIC,DLAYGO Q:Y<0
  1. L +^PRCF(421.7):5 I '$T S X="Document Locator Number file unavailable - File lock timeout.*" D MSG^PRCFQ Q
  1. S Y(0)=^PRCF(421.7,+Y,0),Y1=$P(Y(0),"^",2)+1,$P(^(0),"^",2,3)=Y1_"^"_DT,Y=Y1 L -^PRCF(421.7):0 K Y(0),Y1,X Q
  1. MSG S PRCFX=$S($D(X)'[0:X,1:""),X="Please hold on while I find the next available number.*" D MSG^PRCFQ S X=PRCFX Q
  1. Q
  1. X S %DT="AET" D ^%DT S X=Y D JD G X
  1. DIS N I F I=1:1:8 W !,$P($T(DISP+I),";",3,99)
  1. I $D(PRC("SITE")) S %A="Do you want me to get you the NEXT DLN",%B="A 'Yes' will display the next number, a 'No' or '^' will not.",%=1 D ^PRCFYN I %=1 D V W !,"The Next DLN is: ",PRCFDLN K PRCFDLN
  1. Q
  1. DISP ;;
  1. ;;The Document Locator Number (DLN) is an eleven (11) position number
  1. ;;composed of the following fields:
  1. ;;
  1. ;;Julian Day Number - 3 numbers
  1. ;;Year - 1 number (last digit of calendar year)
  1. ;;Data Origin Code - 1 number (ALWAYS a '7' for IFCAP)
  1. ;;Station Number - 3 numbers
  1. ;;Sequence Number - 3 numbers (Starts at one (001) every day)