source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC5CON2.m@ 1693

Last change on this file since 1693 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1PRC5CON2 ;WISC/PLT-PRC5CON CONTINUE ; 09/12/95 11:24 AM
2V ;;5.0;IFCAP;**27**;4/21/95
3 ;QUIT ; invalid entry
4 ;
5EN ;start convert CALM code sheet to FMS
6 N PRCRI,PRCA,PRCB,PRCC,PRCD,PRCSITE,PRCPAT,PRCTD,PRCRD,PRCCNT
7 N A,B,C
8 S A=$$DATE^PRC0C($H,"H") I $P(A,"^",7)<2951014 D MMCALM("IFCAP V5 CALM CODE SHEET CONVERSION TOO EARLY^IFCAP V5 CALM CODE SHEETS CONVERSION USER","Please run this CALM code sheet conversion after 10/13/95.") QUIT
9 D:'$D(ZTQUEUED) EN^DDIOL("IFCAP V5 calm code sheet conversion starts at "_$$NOW^PRC5A)
10 ;^TMP("PRCCALM",$J,SITE-PAT#)=earliest transaction date^earliest transmision date
11 K ^TMP("PRCCALM",$J)
12 S PRCRI(420.92)=$O(^PRCU(420.92,"B","PRCCALM","")) D:PRCRI(420.92)
13 . D DELETE^PRC0B1(.X,"420.92;^PRCU(420.92,;"_PRCRI(420.92))
14 . QUIT
15 ;get from batch/print entry
16 S PRCA="95-100000" F S PRCA=$O(^PRCF(421.2,"E",PRCA)) QUIT:'PRCA D
17 . S PRCRI(421.2)=0 F S PRCRI(421.2)=$O(^PRCF(421.2,"E",PRCA,PRCRI(421.2))) QUIT:'PRCRI(421.2) I PRCRI(421.2) S PRCC=$G(^PRCF(421.2,PRCRI(421.2),0)) I $P(PRCC,"-",2)="CLM",$P(PRCC,"^",3)="B" D
18 .. S PRCC=$P(PRCC,"^")
19 .. S PRCRI(423)=0 F S PRCRI(423)=$O(^PRCF(423,"AD",PRCC,PRCRI(423))) QUIT:'PRCRI(423) D F423
20 . QUIT
21 ;get code sheet from 423 if not batched/printed
22 S PRCRI(423)=0 F S PRCRI(423)=$O(^PRCF(423,"AC","N",PRCRI(423))) QUIT:'PRCRI(423) D F423
23 ;copy ^TMP entry to file 420.92
24 S PRCRI(420.92)=$O(^PRCU(420.92,"B","PRCCALM","")) D:'PRCRI(420.92)
25 . N A
26 . S X="PRCCALM",X("DR")="1////IFCAP V4 PO 1996 CALM CODE SHEET;2///^S X=""N"""
27 . D ADD^PRC0B1(.X,.Y,"420.92;^PRCU(420.92,")
28 . I Y=-1 K Y I Y W:'$D(ZTQUEUED) !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
29 . S PRCRI(420.92)=+Y
30 . QUIT
31 S PRCA="" F S PRCA=$O(^TMP("PRCCALM",$J,PRCA)) QUIT:'PRCA S PRCB=$G(^(PRCA)) D
32 . S PRCC=PRCA_"~"_$TR(PRCB,"^","~")
33 . S A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";3~420.923;^PRCU(420.92,"_PRCRI(420.92)_",1,"
34 . S X=0,X("DR")=".01///^S X=DA;1///^S X=PRCC"
35 . D ADD^PRC0B1(.X,.Y,A) I Y=-1 S PRCERR=102
36 . QUIT
37 D EDIT^PRC0B(.X,"420.92;^PRCU(420.92,;"_PRCRI(420.92),"2.5///^S X=""N""","LS")
38 S A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";4~420.924;^PRCU(420.92,"_PRCRI(420.92)_",2,"
39 S X="|NOWRAP|"
40 D ADD^PRC0B1(.X,.Y,A)
41 I Y=-1 K Y I Y W:'$D(ZTQUEUED) !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
42 K ^TMP("PRCCALM",$J)
43EN1 ;generate FMS documents
44 S PRCCNT=0
45 S PRCRI(420.92)=$O(^PRCU(420.92,"B","PRCCALM","")) I PRCRI(420.92) S PRCA=^PRCU(420.92,PRCRI(420.92),0) D:$P(PRCA,"^",4)]""&($P(PRCA,"^",6)="")
46 . D ED^PRC5B1(PRCRI(420.92),1)
47 . S PRCRI(420.923)=0
48 . F S PRCRI(420.923)=$O(^PRCU(420.92,PRCRI(420.92),1,PRCRI(420.923))) Q:'PRCRI(420.923) D:$P(^(PRCRI(420.923),0),"^",2)="" FMSDOC(PRCRI(420.92),PRCRI(420.923))
49 . D ED^PRC5B1(PRCRI(420.92),2)
50 . QUIT
51 D MMCALM("IFCAP V5 CALM CODE SHEETS CONVERSION DONE^IFCAP V5 CALM CODE SHEETS CONVERSION USER","IFCAP V5 CALM code sheets conversion done. Total FMS documents = "_PRCCNT)
52 D:'$D(ZTQUEUED) EN^DDIOL("IFCAP V5 CALM code sheet conversion ends at "_$$NOW^PRC5A)
53 QUIT
54 ;
55F423 ;get entry in file 423
56 S PRCD=$G(^PRCF(423,PRCRI(423),0)),PRCRD=$G(^("TRANS"))
57 QUIT:PRCD=""!(PRCRD="")
58 S PRCSITE=$P(PRCD,"^",2),PRCPAT=$P(PRCD,"^",6),PRCTD=$$DATE^PRC0C($P(PRCD,"^",5),"E"),PRCTD=$P(PRCTD,"^",7),PRCRD=$P(PRCRD,"^",3)
59 W:'$D(ZTQUEUED) !,PRCD,!,PRCRI(423)," ",PRCTD," ",PRCSITE," ",PRCPAT
60 QUIT:$P(PRCD,"^",10)'="CLM" QUIT:PRCRD<2951001!'PRCRD
61 S A=$G(^TMP("PRCCALM",$J,PRCSITE_"-"_PRCPAT))
62 I A]"" S:$P(A,"^")>PRCTD $P(A,"^")=PRCTD S:$P(A,"^",2)>PRCRD $P(A,"^",2)=PRCRD
63 I A="" S $P(A,"^")=PRCTD,$P(A,"^",2)=PRCRD
64 S ^TMP("PRCCALM",$J,PRCSITE_"-"_PRCPAT)=A
65 QUIT
66 ;
67FMSDOC(PRCA,PRCB) ;PRCA=ri of file 420.92, prcb=ri of file 420.923
68 ; generate FMS doc
69 N PRCRI,PRCC,PRCD,PRCE,A
70 S PRCRI(420.92)=PRCA,PRCRI(420.923)=PRCB
71 S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCC=$P(A,"~",1),PRCD=$P(A,"~",3)
72 S PRCRI(442)=$O(^PRC(442,"B",PRCC,"")) QUIT:'PRCRI(442)
73 S PRCE=$G(^PRC(442,PRCRI(442),0))
74 I $P(PRCE,"^",2)=21 QUIT:'$P(PRCE,"^",12) S A=$G(^PRCS(410,$P(PRCE,"^",12),0)) QUIT:$P(A,"-",2)<96
75 I $P(PRCE,"^",2)'=21,$P($G(^PRC(442,PRCRI(442),1)),"^",15)<2951001,$D(^(6)) D QUIT
76 . S A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";4~420.924;^PRCU(420.92,"_PRCRI(420.92)_",2,"
77 . S X=PRCC_" - 1995 or earlier P.O. with Amendment, no FMS-doc generated."
78 . D ADD^PRC0B1(.X,.Y,A)
79 . I Y=-1 K Y I Y W:'$D(ZTQUEUED) !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
80 . QUIT
81 S A=$P(PRCE,"^",15),A=$S(A>2950930:"E",1:"E")
82 D
83 . N PRCA,PRCB,PRCCON3
84 . S PRCCON3=1 D EN^PRC5CON3(PRCRI(442),A,PRCD) S PRCCNT=PRCCNT+1
85 . QUIT
86 D ED1^PRC5B1(PRCA,PRCB) ;edit convert field in file 420.923
87 QUIT
88 ;
89MMCALM(A,B) ;send CALM conversion done message
90 N X,Y
91 S X(1)=B
92 S Y(.5)="",Y(PRCDUZ)="",Y("G.CSFISMGMT@FORUM.VA.GOV")=""
93 D MM^PRC0B2(A,"X(",.Y)
94 K PRCDUZ
95 QUIT
Note: See TracBrowser for help on using the repository browser.