source: FOIAVistA/trunk/r/ZZOTHER/MUSMCR1.m@ 868

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1MUSMCR1 ;CREDIT MONITORING PROGRAM
2 ;
3 Q
4CHK ;
5 I $L(D)=9 S D1=D Q
6 I $L(D)=8 S D1="0"_D Q
7 I $L(D)=7 S D1="00"_D Q
8 Q
9 Q
10EN10 ;
11 R !,"Please Enter Directory where file exist: ",DIR Q:DIR="^"
12 R !,"Please enter File to import: ",FILE Q:FILE="^"
13EN11 R !,"(S)SN's or (P)romo codes: ",CODE Q:CODE="^"
14 I "Ss"[$E(CODE,1) G SSN
15 I "Pp"[$E(CODE,1) G CODE
16 W !,"Please type S or P.........",!*7 G EN11
17 Q
18SSN ;
19 S $ZT="EOF"
20 S F=DIR_FILE
21 S D=1 O F:("RW") F U F R A U 0 S ^MUSMCRS1(D)=A,D=D+1
22 Q
23CODE ;
24 S $ZT="EOF"
25 S F=DIR_FILE
26 S D=1 O F:("RW") F U F R A U 0 S ^MUSMCRC1(D)=A,D=D+1
27 Q
28MERGE ;
29 S M=0 F S M=$O(^MUSMCRS1(M)) Q:M'>0 S D=^MUSMCRS1(M) D CHK S ^MUSMCRM(D1)=^MUSMCRC1(M)
30 Q
31PRT ;
32 R !,"(I)ntial Letter or (P)romo Code Letter: ",LET Q:LET="^"
33 R !,"(A)live or (D)eceased patients: ",AD Q:AD="^"
34BEG1 S %ZIS="QF" D ^%ZIS Q:POP
35 I $D(IO("Q")) K IO("Q") S ZTRTN="QUE^MUSMCR1",ZTDESC="MONITOR PROGRAMS",ZTSAVE("LET")="",ZTSAVE("AD")="" D ^%ZTLOAD Q
36 I IO'=IO(0) O IO U IO D QUE,^%ZISC Q
37QUE ;
38 S D=0 F S D=$O(^MUSMCRM(D)) Q:D'>0 S DFN=$O(^DPT("SSN",D,0)) D
39 I "Dd"[$E(AD,1) I DFN]"",$D(^DPT(DFN,.35)) I $P(^(.35),"^",1)'="" D BEG^MUSMCR2
40 .I "Aa"[$E(AD,1) I DFN]"" D I $D(FLAG) K FLAG D BEG^MUSMCR3
41 ..I $D(^DPT(DFN,.35)),$P(^DPT(DFN,.35),"^",1)="" S FLAG=1 Q
42 ..I '$D(DPT(DFN,.35)) S FLAG=1 Q
43 Q
44EOF ;
45 U 0
46 I $ZE["ENDOFFILE" W !,"End of File" S $ZT="" C F
47 Q
Note: See TracBrowser for help on using the repository browser.