source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH7D.m@ 1719

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1PRCH7D ;WISC/PLT - PURCHASE CARD HOME OXYGEN ORDER (BILLING) INTERFACE ; 8/23/99 2:45pm
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry
5 ;
6 ;.prca passing ^1= station #, ^2=ri of 440 (vendor)
7 ;.prca return variable ^1=ri of 442, ^2=p.o. order # without station #
8 ; ^3=card #
9 ; or "^" for quit
10ADD(PRCA) ;add new order
11 N PRC,PRCHPC,PRCPROST,PRCRI
12 N OUT,PRCHBOC1,PRCHCC,PRCHCD,PRCHCDF,PRCHCDFT,PRCHCDNO,PRCHDLOC,PRCHHLDR,PRCHIEN,PRCHII,PRCHNN,PRCHP0,PRCHVEN,PRCHXXX,PRCY,STR1
13 N DA,A,B,X,Y
14 D DUZ^PRCFSITE
15 S PRCRI(420)=+PRCA,PRC("SITE")=$P(PRCA,"^"),PRCRI(440)=$P(PRCA,"^",2)
16 S X="" S:$D(PRC("SITE")) PRC("PARAM")=^PRC(411,PRC("SITE"),0)
17 S (PRCPROST,PRCHPC)=1
18 D ENPO^PRCHUTL G:'$D(PRCHPO) ADDEX D LCK1^PRCHE G:'$G(DA) ADDEX D ^PRCHNPO L -^PRC(442,DA)
19ADDEX S PRCA="" I PRCPROST=1.9 S PRCRI(442)=+DA,PRCA=+DA,A=$P(^PRC(442,PRCA,0),"^"),$P(PRCA,"^",2)=$P(A,"-",2),$P(PRCA,"^",3)=$P($G(^(23)),"^",16)
20 I PRCA D
21 . S A="442;^PRC(442,;"_PRCRI(442)_";20~442.04;^PRC(442,"_PRCRI(442)_",4,"
22 . S X="|NOWRAP|"
23 . D ADD^PRC0B1(.X,.Y,A)
24 . QUIT
25 I PRCA="" D:$G(DA) CANIC(+DA) S PRCA="^"
26 D
27 . N PRCA D Q^PRCHNPO4
28 . QUIT
29 QUIT
30 ;
31 ;prca=monthly total amount of home oxygen bill (not partial amount)
32 ;prcb=ri of file 442
33 ;prcc=array variable name (may be local or global and data stored in first dimenension)
34EDITIC(PRCA,PRCB,PRCC) ;edit order with patient and patient amount
35 N PRC,PRCPROST,PRCHOM,PRCHPC,PRCRI,DA,A,B
36 N PRCHBOC1,PRCHCC,PRCHCD,PRCHCDF,PRCHCDFT,PRCHCDNO,PRCHDLOC,PRCHFCP,PRCHHLDR,PRCHIEN,PRCHII,PRCHLOG,PRCHN,PRCHNN,PRCHP0,PRCHPO,PRCHPONO,PRCHSTN,PRCHTOT,PRCHVEN,PRCHXXX,PRCY,STR1
37 N FLG1 S FLG1=1
38 S (PRCPROST,PRCHOM)=2,PRCHPC=1
39 D PRC(PRCB)
40 S PRCRI(442)=+PRCB D EDIT^PRC0B(.X,"442;^PRC(442,;"_PRCRI(442),"60////"_PRCA_";91////"_PRCA)
41 ;add patient and patient amount in comments field #20
42 I X>0 S PRCRI="" F S PRCRI=$O(@(PRCC_"(PRCRI)")) QUIT:'PRCRI D
43 . S A="442;^PRC(442,;"_PRCRI(442)_";20~442.04;^PRC(442,"_PRCRI(442)_",4,"
44 . S X=@(PRCC_"(PRCRI)")
45 . D ADD^PRC0B1(.X,.Y,A)
46 . QUIT
47 QUIT
48 ;
49 ;.X = "^" if abort
50OBL(X,PRCA,PRCB,PRCC) ;obligate order, prca="" not in use, prcb=ri of file 442, prcc=monthly total amount of home oxygen bill
51 N PRCPROST,PRCHPC,PRCRI,A,B,Y,DIE
52 N N,PRC,NET,PO,PODIEPRC,PRCHCD,PRCHCI,PRCHCPO,PRCHOBL,PRCHPOMT,PRCHSP,PRCSINV,RECORD1,RECORD10,RECORD2,RECORD3,RECORD4,SHPGBOC,STA,X1
53 N PRCHPO,PRCHTOT,PRCHBOCC,PRCHBOC1,PRCHN
54 D DUZ^PRCFSITE,PRC(PRCB)
55 S PRCPROST=3,PRCHPC=1
56 S PRCRI(442)=PRCB
57 S PRCHPO=PRCRI(442),PRCHTOT=PRCC
58 S A=^PRC(440.5,$P(^PRC(442,PRCRI(442),23),"^",8),0),PRCHBOC1=$P(A,U,4)
59 S DIE="^PRC(442,",DA=PRCHPO,DR="60////"_PRCHTOT_";91////"_PRCHTOT_";65////RMPR" D ^DIE K DR
60 S PRCHN("SFC")=+$P(^PRC(442,PRCRI(442),0),U,19)
61 S:'$D(^PRC(442,PRCHPO,2,0)) $P(^PRC(442,PRCHPO,2,0),U,2)=$P(^DD(442,40,0),U,2)
62 S DA(1)=PRCHPO,DIE="^PRC(442,"_DA(1)_",2,",DA=1
63 S DR=".01///^S X=1;1///Home Oxygen Monthly Billing;2///^S X=1;3///^S X=""EA"";5////^S X=PRCHTOT;3.1///^S X=1;9.7///^S X=1;9///^S X="""";8///^S X=9999;K PRCHBOCC;"
64 S DR(1,442.01,1)="I PRCHN(""SFC"")=2 S PRCHBOCC=2696;I '$G(PRCHBOCC) S Y=""@87"";"
65 S DR(1,442.01,2)="S PRCHBOCC=$P($G(^PRCD(420.2,PRCHBOCC,0)),U);3.5////^S X=PRCHBOCC;S Y=""@89"";@87;3.5////^S X=PRCHBOC1;@89;K PRCHBOCC"
66 D ^DIE
67 ;S DIE="^PRC(442,",DA=PRCHPO,DR=20 D ^DIE
68 I '$D(Y) D PROS^PRCHNPO
69 S X="" I PRCPROST=3 D CANIC(PRCRI(442)) S X="^"
70 QUIT
71 ;
72CANIC(PRCA) ;cancel order, prca=ien of file 442
73 N PRCPROST,PRCHPC,A,B,X,Y
74 S PRCPROST=99,PRCHPC=1
75 D EDIT^PRC0B(.X,"442;^PRC(442,;"_PRCA,".5///^S X=45")
76 S DA=PRCA D C2237^PRCH442A K DA,%A,%B,%
77 QUIT
78 ;
79 ;.x return variable ="^" if abort
80 ; prca = "" not in use, prcb = ri of file 442, prcc=zero amount
81CAN(X,PRCA,PRCB,PRCC) ;cancel home oxygen billing order
82 N PRC,PRCRI,PRCPROST,PRCHAUTH
83 N Y
84 N PRCF,RETURN,PRCHAM,PRCHPO,PRCHNEW,OUT,CAN,PRCHAU,PRCHER,PRCHON,NOCAN
85 N A,B,ER,FL,FIS,DELIVER,PRCHAMDA,PRCHAV,PRCHL1,PRCHLN,PRCHRET,LCNT
86 N PRCHX,PRCHIMP,PRCHNRQ,PRCHP,PRCHPO,REPO,PRCHNORE,%,%A,%B,D0,D1,J
87 N PRCHL2,ROU,DIC,I,PRCHAMT,PRCHAREC,PRCHEDI,PRCHN,PRCHO,SFUND
88 D DUZ^PRCFSITE
89 S PRCHNEW="",PRCHNORE=1,CAN=1
90 S PRCHAUTH=1,PRCPROST=90
91 S PRCRI(442)=+PRCB,PRCHPO=PRCRI(442)
92 S A=$P(^PRC(442,PRCRI(442),0),"^"),PRC("SITE")=$P(A,"-")
93 I '$$VERIFY^PRCHES5(PRCHPO) W !!,?5,"This purchase order has been tampered with.",!,?5,"Please notify IFCAP APPLICATION COORDINATOR.",! G CANEX
94 S B=5 D ICLOCK^PRC0B("^PRC(442,"_PRCHPO_",",.B)
95 D AMENDNO^PRCHAMU D DCLOCK^PRC0B("^PRC(442,"_PRCHPO_",") G:'$G(PRCHAM) CANEX
96 S PRCHAMT=0,FL=0 D INFO^PRCHAMU G:$D(PRCHAV)!ER CANEX
97 S X=$P($G(^PRC(443.6,PRCHPO,0)),U,16) D EN2^PRCHAMXB
98 I PRCHNEW="" S DA(1)=PRCHPO,DA=PRCHAM,PRCHX=X,X=0,PRCHAMDA=34 D EN8^PRCHAMXB S X=PRCHX
99 I $P(^PRC(443.6,PRCHPO,6,PRCHAM,0),U,4)=5!($P(^(0),U,4)=15) S CAN=1
100 I $G(CAN)>0 D ENC^PRCHMA G:ER CANEX I $G(NOCAN)=0 S DA(1)=PRCHPO,DA=PRCHAM,PRCHAMDA=34,PRCHX=X,X=0 D EN8^PRCHAMXB S X=PRCHX D CAN1^PRCHMA
101 K FIS,REPO,DEL
102CANEX S X="" I PRCPROST=90 S X="^"
103 QUIT
104 ;
105PRC(X) ;x = ien of file 442, return PRC local array for site, bbfy, fy, qtr
106 S PRC("SITE")=$P($G(^PRC(442,X,0)),"-"),PRC("BBFY")=$P($G(^(23)),"^",2)/10000+1700,X=$$DATE^PRC0C($P($G(^(1)),"^",15),"I")
107 S PRC("FY")=$E(X,3,4),PRC("QTR")=$P(X,"^",2)
108 S PRC("PARAM")=^PRC(411,PRC("SITE"),0) D DUZ^PRCFSITE
109 QUIT
Note: See TracBrowser for help on using the repository browser.