| 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
 | 
|---|