source: FOIAVistA/trunk/r/MEDICINE-MC/MCARAP.m@ 899

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1MCARAP ;WASH ISC/SAE-MEDICINE AUTO INSTRUMENT INTERFACE SUMMARY PRINT ;5/7/96 09:40
2 ;;2.3;Medicine;**16**;09/13/1996
3 ;
4 D NOW^%DTC S Y=% D DD^%DT S MCDAY=$E(Y,1,12),MCTIME=$E(Y,13,18)
5 K GOOD,BAD,J,DIC,ENTRY,DATE1,DATE2,PDATE,IJ,ZIP,REDO,NAME,ALL
6 W @IOF,?17,"MEDICINE AUTO INSTRUMENT SUMMARY OF RECORDS TRANSFER"
7 W !!!!,?5,"S",?10,"SUCCESSFUL RECORD TRANSFERS"
8 W !!,?5,"U",?10,"UNSUCCESSFUL RECORD TRANSFERRAL ATTEMPTS"
9 W !!,?5,"A",?10,"ALL RECORD TRANSFERRAL ATTEMPTS"
10ASK R !!!,"Enter selection(S,U,A), '?' for help, or return to escape: ",RPT:DTIME
11 G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:RPT="" K GOOD,BAD,ALL
12 I RPT="S" S GOOD=1 K BAD G NAME
13 I RPT="U" S BAD=1 K GOOD G NAME
14 I RPT="A" S ALL=1 K GOOD,BAD G NAME
15 I RPT="?" D QMARK^MCARAP2
16 I RPT="?" D PROMPT G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U D QMARK2^MCARAP2,PROMPT G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U,MCARAP
17 I RPT=U!(RPT="") G EXIT1^MCARAP1
18 G MCARAP
19PROMPT R !!,"Press return to continue, or '^' to escape: ",ZIP:DTIME Q
20UPDATE ; Kill all nodes for entries more than 1 month old
21 D NOW^%DTC S X1=%
22 W @IOF,!,?14,"MEDICINE AUTO INSTRUMENT SUMMARY OF RECORDS TRANSFER"
23 W !!!,?14,"Enter the number of days of reports you wish to retain"
24 W !,?14,"(30 day minimum), or return to escape: ",*7 R PERIOD:DTIME G:'$T!(PERIOD=U)!(PERIOD="") EXIT1^MCARAP1 G:PERIOD<30 UPDATE
25 S X2=-PERIOD D C^%DTC S EXDAY=X ; B
26 S PDATE=0 F IJ=1:1 S PDATE=$O(^MCAR(700.5,"C",PDATE)) Q:PDATE="" Q:PDATE>EXDAY D STYPE^MCARAP1 I $D(TYPE) K TYPE S ENT="",ENTRY(IJ)=$O(^MCAR(700.5,"C",PDATE,ENT))
27 F IJ=1:1 Q:'$D(ENTRY(IJ)) S DIK="^MCAR(700.5,",DA=ENTRY(IJ) D ^DIK
28 K MCARA,EXDAY,IJ,DIK,ENT,ENTRY,PDATE,PERIOD Q
29NAME R !!,"Enter Patient Name (if single Patient search), or '^' to escape: ",NAME:DTIME
30 I '$T K NAME G EXIT^MCARAP1
31 I NAME=U K NAME G EXIT1^MCARAP1
32 I NAME="?" W !,"Enter name (examples: SM/SMITH/SMITH,BILL/SMITH,BILL M)",!,"...or press return to search all Patients)" G NAME
33 I NAME?1." ".E W !,"Leading spaces not acceptable",*7 G NAME
34 I '$D(NAME)!(NAME="") K NAME G DATE1
35 S:NAME[", " NAME=$P(NAME,",")_","_$P(NAME,", ",2) S:NAME[" " NAME=$P(NAME," ")_" "_$P(NAME," ",2)
36 S NAMEE=$E(NAME,1,($L(NAME)-1))_$C($A($E(NAME,$L(NAME)))-1)_"ZZZ"
37 K ^TMP($J,"MCARA")
38 F J=1:1 S NAMEE=$O(^MCAR(700.5,"PT",NAMEE)) Q:NAMEE="" Q:NAME'=$E(NAMEE,1,$L(NAME)) S RN=$O(^(NAMEE,0)),^TMP($J,"MCARA",J)=NAMEE_U_$P(^MCAR(700.5,RN,0),U,3)
39 G:'$D(^TMP($J,"MCARA")) NAME2
40 W ! F J=1:1 Q:'$D(^TMP($J,"MCARA",J)) W !,?5,J,?10,$P(^(J),U),?40,$P(^(J),U,2)
41NAME1 R !!,"Enter Number: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U
42 I ZIP="" W !!,"No Individual Patient selected",*7 K NAME G NAME
43 I ZIP="?" W !,"Enter Number to select Patient, press return to continue, or enter ^ to exit" G NAME1
44 I '$D(^TMP($J,"MCARA",ZIP)) W !,"No Individual Patient selected",*7 G NAME1
45 S NAME=$P(^TMP($J,"MCARA",ZIP),U)
46 G DATE1
47NAME2 W !,"No Entries found in Summary File",*7 G NAME
48DATE1 ; Enter starting date of range of dates for report
49 W !! K DTOUT S %DT="AEXPT",%DT("A")="Enter Starting Date: ",%DT("B")="TODAY",%DT(0)="-NOW"
50 D ^%DT I X="" K %DT(0) Q
51 G:$D(DTOUT) MCARAP G:X=U EXIT1^MCARAP1
52 I Y=-1 W *7 R !!,"Invalid date, press return to continue, or ^ to exit: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U W ! G DATE1
53 S DATE1=Y
54DATE2 K DTOUT S %DT="AEXPT",%DT("A")="Enter Ending Date: ",%DT("B")="TODAY",%DT(0)="-NOW"
55 D ^%DT I X="" K %DT(0) Q
56 G:$D(DTOUT) MCARAP G:X=U EXIT1^MCARAP1
57 I Y=-1 W *7 R !!,"Invalid date, press return to continue, or ^ to exit: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U W ! G DATE2
58 S DATE2=Y I DATE2<DATE1 W *7 R !!,"Starting date must precede or equal ending date",!,"Press return to continue, or ^ to exit: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U W ! G DATE1
59DEVICE ; Select Device
60 K IO("Q") S %ZIS="Q" D ^%ZIS G EXIT1^MCARAP1:POP
61QUE ; Perform queueing if selected
62 I $D(IO("Q")) S ZTRTN="^MCARAP1",ZTSAVE("DATE*")="",ZTDESC="Medicine Auto Instrument Interface Summary Report" S:$D(GOOD) ZTSAVE("GOOD")="" S:$D(BAD) ZTSAVE("BAD")="" S:$D(NAME) ZTSAVE("NAME")="" S REDO=1
63 I $D(IO("Q")) S:$D(MCARA) ZTSAVE("MCARA")=MCARA S:$D(ALL) ZTSAVE("ALL")="" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^MCARAP1
64 U IO
65 G ^MCARAP1
Note: See TracBrowser for help on using the repository browser.