1 | GMPL31P ;SLC/JEH -- Post Install Routine ;3/1/05 11:00
|
---|
2 | ;;2.0;Problem List;**31**;Aug 25, 1994
|
---|
3 | ;
|
---|
4 | ; This routine can be removed after installing patch
|
---|
5 | ; GMPL*2*31 or kept and used as IRM tool
|
---|
6 | Q
|
---|
7 | EN ;ENTRY POINT
|
---|
8 | ;
|
---|
9 | N IEN,TOTALWK,ADJUSTED
|
---|
10 | S IEN=0
|
---|
11 | S TOTALWK=0
|
---|
12 | S ADJUSTED=0
|
---|
13 | W !,"THE FOLLOWING PROBLEM LIST ENTRIES CONTAINED BAD ICD9 POINTERS"
|
---|
14 | W !,"AND HAVE BEEN MODIFIED WITH A CORRECTED POINTER",!
|
---|
15 | W !,"PROBLEM IEN BAD POINTER CORRECTED POINTER"
|
---|
16 | W !,"___________ ___________ _______________"
|
---|
17 | F S IEN=$O(^AUPNPROB(IEN)) Q:IEN="" D
|
---|
18 | .I $P($G(^AUPNPROB(IEN,0)),"^")["-1" D
|
---|
19 | ..W !,IEN,?16,$P(^AUPNPROB(IEN,0),"^")
|
---|
20 | ..S $P(^AUPNPROB(IEN,0),"^",1)=$P($$NOS^GMPLX,"^",1)
|
---|
21 | ..W ?36,$P(^AUPNPROB(IEN,0),"^",1)
|
---|
22 | ..S ADJUSTED=ADJUSTED+1
|
---|
23 | ..Q
|
---|
24 | .I $P($G(^AUPNPROB(IEN,0)),"^")["~" D
|
---|
25 | ..W !,IEN,?16,$P(^AUPNPROB(IEN,0),"^")
|
---|
26 | ..S $P(^AUPNPROB(IEN,0),"^",1)=+$P(^AUPNPROB(IEN,0),"^",1)
|
---|
27 | ..W ?36,$P(^AUPNPROB(IEN,0),"^",1)
|
---|
28 | ..S ADJUSTED=ADJUSTED+1
|
---|
29 | .S TOTALWK=TOTALWK+1
|
---|
30 | W !!,"TOTAL ITEMS WORKED = "_TOTALWK
|
---|
31 | W !,"TOTAL ITEMS ADJUSTED = "_ADJUSTED
|
---|
32 | W !!
|
---|
33 | D AUDTCLN
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | AUDTCLN ;
|
---|
37 | N IEN,TOTALWK,ADJUSTED,HIT
|
---|
38 | S IEN=0
|
---|
39 | S TOTALWK=0
|
---|
40 | S ADJUSTED=0
|
---|
41 | W !,"THE FOLLOWING PROBLEM LIST AUDIT ENTRIES CONTAINED BAD ICD9 POINTERS"
|
---|
42 | W !,"AND HAVE BEEN MODIFIED WITH A CORRECTED POINTER",!
|
---|
43 | W !,"PROBLEM IEN BAD POINTER CORRECTED POINTER"
|
---|
44 | W !,"___________ ___________ _______________"
|
---|
45 | F S IEN=$O(^GMPL(125.8,IEN)) Q:IEN="" D
|
---|
46 | .I $P($G(^GMPL(125.8,IEN,0)),"^",2)'=.01 Q
|
---|
47 | .S HIT=0
|
---|
48 | .; look at the 5th piece
|
---|
49 | .I $P($G(^GMPL(125.8,IEN,0)),"^",5)["-1" D
|
---|
50 | ..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",5)
|
---|
51 | ..S $P(^GMPL(125.8,IEN,0),"^",5)=$P($$NOS^GMPLX,"^",1)
|
---|
52 | ..W ?36,$P(^GMPL(125.8,IEN,0),"^",5)
|
---|
53 | ..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
|
---|
54 | ..;
|
---|
55 | .I $P($G(^GMPL(125.8,IEN,0)),"^",5)["~" D
|
---|
56 | ..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",5)
|
---|
57 | ..S $P(^GMPL(125.8,IEN,0),"^",5)=+$P(^GMPL(125.8,IEN,0),"^",5)
|
---|
58 | ..W ?36,$P(^GMPL(125.8,IEN,0),"^",5)
|
---|
59 | ..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
|
---|
60 | ..;
|
---|
61 | .; look at the 6th piece
|
---|
62 | .I $P($G(^GMPL(125.8,IEN,0)),"^",6)["-1" D
|
---|
63 | ..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",6)
|
---|
64 | ..S $P(^GMPL(125.8,IEN,0),"^",6)=$P($$NOS^GMPLX,"^",1)
|
---|
65 | ..W ?36,$P(^GMPL(125.8,IEN,0),"^",6)
|
---|
66 | ..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
|
---|
67 | ..;
|
---|
68 | .I $P($G(^GMPL(125.8,IEN,0)),"^",6)["~" D
|
---|
69 | ..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",6)
|
---|
70 | ..S $P(^GMPL(125.8,IEN,0),"^",6)=+$P(^GMPL(125.8,IEN,0),"^",6)
|
---|
71 | ..W ?36,$P(^GMPL(125.8,IEN,0),"^",6)
|
---|
72 | ..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
|
---|
73 | .S TOTALWK=TOTALWK+1
|
---|
74 | W !!,"TOTAL AUDIT ITEMS WORKED = "_TOTALWK
|
---|
75 | W !,"TOTAL AUDIT ITEMS ADJUSTED = "_ADJUSTED
|
---|
76 | W !,"AN ITEM IEN MAY APPEAR UP TO 2 TIMES ONE FOR EACH BAD PIECE"
|
---|
77 | W !,"AS THE FIFTH AND SIXTH PIECES ARE CHECKED"
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | ;
|
---|
81 | FIND ;
|
---|
82 | ;find and display bad ICD9 pointers in Problem List ONLY
|
---|
83 | N IEN,TOTALWK,ADJUSTED
|
---|
84 | S IEN=0
|
---|
85 | S TOTALWK=0
|
---|
86 | S ADJUSTED=0
|
---|
87 | F S IEN=$O(^AUPNPROB(IEN)) Q:IEN="" D
|
---|
88 | .S TOTALWK=TOTALWK+1
|
---|
89 | .I $P($G(^AUPNPROB(IEN,0)),"^")["-1" W !,IEN,?10,$P(^AUPNPROB(IEN,0),"^") S ADJUSTED=ADJUSTED+1 Q
|
---|
90 | .I $P($G(^AUPNPROB(IEN,0)),"^")["~" W !,IEN,?10,$P(^AUPNPROB(IEN,0),"^") S ADJUSTED=ADJUSTED+1
|
---|
91 | W !,"TOTAL ITEMS LOOKED AT = "_TOTALWK
|
---|
92 | W !,"TOTAL BAD POINTERS FOUND = "_ADJUSTED
|
---|
93 | Q
|
---|
94 | ;
|
---|
95 | FDAUDIT ;
|
---|
96 | ;finnd and display bad ICD9 pointer in the Audit file
|
---|
97 | N IEN,TOTALWK,ADJUSTED
|
---|
98 | S IEN=0
|
---|
99 | S TOTALWK=0
|
---|
100 | S ADJUSTED=0
|
---|
101 | F S IEN=$O(^GMPL(125.8,IEN)) Q:IEN="" D
|
---|
102 | .S TOTALWK=TOTALWK+1
|
---|
103 | .I $P($G(^GMPL(125.8,IEN,0)),"^")["-1" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^") S ADJUSTED=ADJUSTED+1 Q
|
---|
104 | .I $P($G(^GMPL(125.8,IEN,0)),"^")["~" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^") S ADJUSTED=ADJUSTED+1
|
---|
105 | .I $P($G(^GMPL(125.8,IEN,0)),"^",5)["-1" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^",5) S ADJUSTED=ADJUSTED+1 Q
|
---|
106 | .I $P($G(^GMPL(125.8,IEN,0)),"^",5)["~" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^",5) S ADJUSTED=ADJUSTED+1
|
---|
107 | .I $P($G(^GMPL(125.8,IEN,0)),"^",6)["-1" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^",6) S ADJUSTED=ADJUSTED+1 Q
|
---|
108 | .I $P($G(^GMPL(125.8,IEN,0)),"^",6)["~" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^",6) S ADJUSTED=ADJUSTED+1
|
---|
109 | W !,"TOTAL ITEMS LOOKED AT = "_TOTALWK
|
---|
110 | W !,"TOTAL BAD POINTERS FOUND = "_ADJUSTED
|
---|
111 | Q
|
---|