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

MUSMCR1.m

Go to the documentation of this file.
  1. MUSMCR1 ;CREDIT MONITORING PROGRAM
  1. ;
  1. Q
  1. CHK ;
  1. I $L(D)=9 S D1=D Q
  1. I $L(D)=8 S D1="0"_D Q
  1. I $L(D)=7 S D1="00"_D Q
  1. Q
  1. Q
  1. EN10 ;
  1. R !,"Please Enter Directory where file exist: ",DIR Q:DIR="^"
  1. R !,"Please enter File to import: ",FILE Q:FILE="^"
  1. EN11 R !,"(S)SN's or (P)romo codes: ",CODE Q:CODE="^"
  1. I "Ss"[$E(CODE,1) G SSN
  1. I "Pp"[$E(CODE,1) G CODE
  1. W !,"Please type S or P.........",!*7 G EN11
  1. Q
  1. SSN ;
  1. S $ZT="EOF"
  1. S F=DIR_FILE
  1. S D=1 O F:("RW") F U F R A U 0 S ^MUSMCRS1(D)=A,D=D+1
  1. Q
  1. CODE ;
  1. S $ZT="EOF"
  1. S F=DIR_FILE
  1. S D=1 O F:("RW") F U F R A U 0 S ^MUSMCRC1(D)=A,D=D+1
  1. Q
  1. MERGE ;
  1. S M=0 F S M=$O(^MUSMCRS1(M)) Q:M'>0 S D=^MUSMCRS1(M) D CHK S ^MUSMCRM(D1)=^MUSMCRC1(M)
  1. Q
  1. PRT ;
  1. R !,"(I)ntial Letter or (P)romo Code Letter: ",LET Q:LET="^"
  1. R !,"(A)live or (D)eceased patients: ",AD Q:AD="^"
  1. BEG1 S %ZIS="QF" D ^%ZIS Q:POP
  1. I $D(IO("Q")) K IO("Q") S ZTRTN="QUE^MUSMCR1",ZTDESC="MONITOR PROGRAMS",ZTSAVE("LET")="",ZTSAVE("AD")="" D ^%ZTLOAD Q
  1. I IO'=IO(0) O IO U IO D QUE,^%ZISC Q
  1. QUE ;
  1. S D=0 F S D=$O(^MUSMCRM(D)) Q:D'>0 S DFN=$O(^DPT("SSN",D,0)) D
  1. I "Dd"[$E(AD,1) I DFN]"",$D(^DPT(DFN,.35)) I $P(^(.35),"^",1)'="" D BEG^MUSMCR2
  1. .I "Aa"[$E(AD,1) I DFN]"" D I $D(FLAG) K FLAG D BEG^MUSMCR3
  1. ..I $D(^DPT(DFN,.35)),$P(^DPT(DFN,.35),"^",1)="" S FLAG=1 Q
  1. ..I '$D(DPT(DFN,.35)) S FLAG=1 Q
  1. Q
  1. EOF ;
  1. U 0
  1. I $ZE["ENDOFFILE" W !,"End of File" S $ZT="" C F
  1. Q