source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACCONV0.m@ 1147

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1QACCONV0 ;HISC/DAD-CONVERT SERVICES ;2/10/95 11:04
2 ;;2.0;Patient Representative;;07/25/1995
3 ;
4 W !!,"The data from the SERVICES INVOLVED multiple (745.1,15->"
5 W !,"745.115,.01, a pointer to the NATIONAL SERVICE file [#730])"
6 W !,"will be moved to the SERV/SECT INVOLVED multiple (745.1,21->"
7 W !,"745.121,1->745.1211,.01, a pointer to the SERVICE/SECTION file"
8 W !,"[#49]). The conversion may be run multiple times without adverse"
9 W !,"effects on the database. The SERVICES INVOLVED will be duplicated"
10 W !,"for each ISSUE CODE. A report will be printed showing any"
11 W !,"conversion problems/issues. It is recommended that you queue"
12 W !,"this report. If you wish to run this conversion/report at a"
13 W !,"later time, enter 'DO ^QACCONV0' at the M programmer prompt."
14 ;
15 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
16 I $D(IO("Q")) D G EXIT
17 . S ZTRTN="TASK^QACCONV0"
18 . S ZTDESC="Patient Representative Service Conversion"
19 . D ^%ZTLOAD
20 . I $G(ZTSK) W !,"Task Number: ",ZTSK
21 . Q
22TASK ;
23 S QACD0=0 K ^TMP($J,"QACPROB")
24 F S QACD0=$O(^QA(745.1,QACD0)) Q:QACD0'>0 D CONVERT
25PRINT ;
26 K QACUNDL S $P(QACUNDL,"-",81)="",QACPAGE=1,QACQUIT=0
27 S QACTODAY=$$FMTE^XLFDT(DT,1)
28 U IO D HEADER
29 I $O(^TMP($J,"QACPROB",""))="" D G EXIT
30 . W !!,"No conversion problems found."
31 . Q
32 S QACNUMBR=""
33 F S QACNUMBR=$O(^TMP($J,"QACPROB",QACNUMBR)) Q:QACNUMBR=""!QACQUIT D
34 . W !!,"Contact Number: ",QACNUMBR
35 . S QACPROB=""
36 . F S QACPROB=$O(^TMP($J,"QACPROB",QACNUMBR,QACPROB)) Q:QACPROB=""!QACQUIT D
37 .. W !,^TMP($J,"QACPROB",QACNUMBR,QACPROB)
38 .. I $Y>(IOSL-6) D PAUSE,HEADER
39 .. Q
40 . Q
41EXIT ;
42 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
43 K %ZIS,D0,D1,DD,DIC,DINUM,DIR,DLAYGO,DO,POP,QAC49,QAC730,QACD0,QACD1
44 K QACFOUND,QACNUMBR,QACPAGE,QACPROB,QACQUIT,QACTODAY,QACUNDL,X,Y
45 K ZTDESC,ZTRTN,ZTSK,^TMP($J,"QACCONV0"),^TMP($J,"QACPROB"),DA(1),DA(2)
46 Q
47CONVERT ;
48 S QACNUMBR=$P($G(^QA(745.1,QACD0,0)),U) Q:QACNUMBR=""
49 I $O(^QA(745.1,QACD0,1,0)),$O(^QA(745.1,QACD0,3,0))'>0 D
50 . S X=" * No Issue Codes found, cannot convert services."
51 . S ^TMP($J,"QACPROB",QACNUMBR,"ISSUE")=X
52 . Q
53 K ^TMP($J,"QACCONV0")
54 S QACD1=0
55 F S QACD1=$O(^QA(745.1,QACD0,1,QACD1)) Q:QACD1'>0 D
56 . S QAC730=$P($G(^QA(745.1,QACD0,1,QACD1,0)),U)
57 . S QAC730(0)=$P($G(^ECC(730,QAC730,0)),U) Q:QAC730(0)=""
58 . S (QAC49,QACFOUND)=0
59 . F S QAC49=$O(^DIC(49,"A1",QAC730,QAC49)) Q:QAC49'>0 D
60 .. I $P($G(^DIC(49,QAC49,0)),U)="" Q
61 .. S ^TMP($J,"QACCONV0",QAC49)="",QACFOUND=QACFOUND+1
62 .. Q
63 . I 'QACFOUND D
64 .. S X=" * No Serv/Sect's for National Serv '"_QAC730(0)_"'."
65 .. S ^TMP($J,"QACPROB",QACNUMBR,QAC730)=X
66 .. Q
67 . I QACFOUND>1 D
68 .. S X=" Multiple Serv/Sect's for National Serv '"_QAC730(0)_"'."
69 .. S ^TMP($J,"QACPROB",QACNUMBR,QAC730)=X
70 .. Q
71 . Q
72 S QACD1=0
73 F S QACD1=$O(^QA(745.1,QACD0,3,QACD1)) Q:QACD1'>0 D
74 . S QAC49=0
75 . F S QAC49=$O(^TMP($J,"QACCONV0",QAC49)) Q:QAC49'>0 D
76 .. I $O(^QA(745.1,QACD0,3,QACD1,1,"B",QAC49,0)) Q
77 .. K DD,DIC,DINUM,DO
78 .. S DIC="^QA(745.1,"_QACD0_",3,"_QACD1_",1,",DIC(0)="L"
79 .. S DIC("P")=$P(^DD(745.121,1,0),U,2),DLAYGO=745.1,X=QAC49
80 .. S (D0,DA(2))=QACD0,(D1,DA(1))=QACD1
81 .. D FILE^DICN
82 .. Q
83 . Q
84 Q
85PAUSE ;
86 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QACQUIT=$S(Y'>0:1,1:0)
87 Q
88HEADER ;
89 I QACQUIT Q
90 W:$E(IOST)="C"!(QACPAGE>1) @IOF
91 W !!?29,"Patient Representative",?68,"Page: ",QACPAGE
92 W !?28,"Service Conversion Report",?68,QACTODAY
93 W !?24,"* - indicates data not converted"
94 W !,QACUNDL S QACPAGE=QACPAGE+1
95 Q
Note: See TracBrowser for help on using the repository browser.