| 1 | MUSMCR1 ;CREDIT MONITORING PROGRAM | 
|---|
| 2 | ; | 
|---|
| 3 | Q | 
|---|
| 4 | CHK ; | 
|---|
| 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 | 
|---|
| 10 | EN10 ; | 
|---|
| 11 | R !,"Please Enter Directory where file exist: ",DIR Q:DIR="^" | 
|---|
| 12 | R !,"Please enter File to import: ",FILE Q:FILE="^" | 
|---|
| 13 | EN11 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 | 
|---|
| 18 | SSN ; | 
|---|
| 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 | 
|---|
| 23 | CODE ; | 
|---|
| 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 | 
|---|
| 28 | MERGE ; | 
|---|
| 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 | 
|---|
| 31 | PRT ; | 
|---|
| 32 | R !,"(I)ntial Letter or (P)romo Code Letter: ",LET Q:LET="^" | 
|---|
| 33 | R !,"(A)live or (D)eceased patients: ",AD Q:AD="^" | 
|---|
| 34 | BEG1 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 | 
|---|
| 37 | QUE ; | 
|---|
| 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 | 
|---|
| 44 | EOF  ; | 
|---|
| 45 | U 0 | 
|---|
| 46 | I $ZE["ENDOFFILE" W !,"End of File" S $ZT="" C F | 
|---|
| 47 | Q | 
|---|