GMPL31P ;SLC/JEH -- Post Install Routine ;3/1/05 11:00
;;2.0;Problem List;**31**;Aug 25, 1994
;
; This routine can be removed after installing patch
; GMPL*2*31 or kept and used as IRM tool
Q
EN ;ENTRY POINT
;
N IEN,TOTALWK,ADJUSTED
S IEN=0
S TOTALWK=0
S ADJUSTED=0
W !,"THE FOLLOWING PROBLEM LIST ENTRIES CONTAINED BAD ICD9 POINTERS"
W !,"AND HAVE BEEN MODIFIED WITH A CORRECTED POINTER",!
W !,"PROBLEM IEN BAD POINTER CORRECTED POINTER"
W !,"___________ ___________ _______________"
F S IEN=$O(^AUPNPROB(IEN)) Q:IEN="" D
.I $P($G(^AUPNPROB(IEN,0)),"^")["-1" D
..W !,IEN,?16,$P(^AUPNPROB(IEN,0),"^")
..S $P(^AUPNPROB(IEN,0),"^",1)=$P($$NOS^GMPLX,"^",1)
..W ?36,$P(^AUPNPROB(IEN,0),"^",1)
..S ADJUSTED=ADJUSTED+1
..Q
.I $P($G(^AUPNPROB(IEN,0)),"^")["~" D
..W !,IEN,?16,$P(^AUPNPROB(IEN,0),"^")
..S $P(^AUPNPROB(IEN,0),"^",1)=+$P(^AUPNPROB(IEN,0),"^",1)
..W ?36,$P(^AUPNPROB(IEN,0),"^",1)
..S ADJUSTED=ADJUSTED+1
.S TOTALWK=TOTALWK+1
W !!,"TOTAL ITEMS WORKED = "_TOTALWK
W !,"TOTAL ITEMS ADJUSTED = "_ADJUSTED
W !!
D AUDTCLN
Q
;
AUDTCLN ;
N IEN,TOTALWK,ADJUSTED,HIT
S IEN=0
S TOTALWK=0
S ADJUSTED=0
W !,"THE FOLLOWING PROBLEM LIST AUDIT ENTRIES CONTAINED BAD ICD9 POINTERS"
W !,"AND HAVE BEEN MODIFIED WITH A CORRECTED POINTER",!
W !,"PROBLEM IEN BAD POINTER CORRECTED POINTER"
W !,"___________ ___________ _______________"
F S IEN=$O(^GMPL(125.8,IEN)) Q:IEN="" D
.I $P($G(^GMPL(125.8,IEN,0)),"^",2)'=.01 Q
.S HIT=0
.; look at the 5th piece
.I $P($G(^GMPL(125.8,IEN,0)),"^",5)["-1" D
..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",5)
..S $P(^GMPL(125.8,IEN,0),"^",5)=$P($$NOS^GMPLX,"^",1)
..W ?36,$P(^GMPL(125.8,IEN,0),"^",5)
..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
..;
.I $P($G(^GMPL(125.8,IEN,0)),"^",5)["~" D
..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",5)
..S $P(^GMPL(125.8,IEN,0),"^",5)=+$P(^GMPL(125.8,IEN,0),"^",5)
..W ?36,$P(^GMPL(125.8,IEN,0),"^",5)
..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
..;
.; look at the 6th piece
.I $P($G(^GMPL(125.8,IEN,0)),"^",6)["-1" D
..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",6)
..S $P(^GMPL(125.8,IEN,0),"^",6)=$P($$NOS^GMPLX,"^",1)
..W ?36,$P(^GMPL(125.8,IEN,0),"^",6)
..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
..;
.I $P($G(^GMPL(125.8,IEN,0)),"^",6)["~" D
..W !,IEN,?16,$P(^GMPL(125.8,IEN,0),"^",6)
..S $P(^GMPL(125.8,IEN,0),"^",6)=+$P(^GMPL(125.8,IEN,0),"^",6)
..W ?36,$P(^GMPL(125.8,IEN,0),"^",6)
..S:HIT=0 ADJUSTED=ADJUSTED+1,HIT=1
.S TOTALWK=TOTALWK+1
W !!,"TOTAL AUDIT ITEMS WORKED = "_TOTALWK
W !,"TOTAL AUDIT ITEMS ADJUSTED = "_ADJUSTED
W !,"AN ITEM IEN MAY APPEAR UP TO 2 TIMES ONE FOR EACH BAD PIECE"
W !,"AS THE FIFTH AND SIXTH PIECES ARE CHECKED"
Q
;
;
FIND ;
;find and display bad ICD9 pointers in Problem List ONLY
N IEN,TOTALWK,ADJUSTED
S IEN=0
S TOTALWK=0
S ADJUSTED=0
F S IEN=$O(^AUPNPROB(IEN)) Q:IEN="" D
.S TOTALWK=TOTALWK+1
.I $P($G(^AUPNPROB(IEN,0)),"^")["-1" W !,IEN,?10,$P(^AUPNPROB(IEN,0),"^") S ADJUSTED=ADJUSTED+1 Q
.I $P($G(^AUPNPROB(IEN,0)),"^")["~" W !,IEN,?10,$P(^AUPNPROB(IEN,0),"^") S ADJUSTED=ADJUSTED+1
W !,"TOTAL ITEMS LOOKED AT = "_TOTALWK
W !,"TOTAL BAD POINTERS FOUND = "_ADJUSTED
Q
;
FDAUDIT ;
;finnd and display bad ICD9 pointer in the Audit file
N IEN,TOTALWK,ADJUSTED
S IEN=0
S TOTALWK=0
S ADJUSTED=0
F S IEN=$O(^GMPL(125.8,IEN)) Q:IEN="" D
.S TOTALWK=TOTALWK+1
.I $P($G(^GMPL(125.8,IEN,0)),"^")["-1" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^") S ADJUSTED=ADJUSTED+1 Q
.I $P($G(^GMPL(125.8,IEN,0)),"^")["~" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^") S ADJUSTED=ADJUSTED+1
.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
.I $P($G(^GMPL(125.8,IEN,0)),"^",5)["~" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^",5) S ADJUSTED=ADJUSTED+1
.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
.I $P($G(^GMPL(125.8,IEN,0)),"^",6)["~" W !,IEN,?10,$P(^GMPL(125.8,IEN,0),"^",6) S ADJUSTED=ADJUSTED+1
W !,"TOTAL ITEMS LOOKED AT = "_TOTALWK
W !,"TOTAL BAD POINTERS FOUND = "_ADJUSTED
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPL31P 4195 printed Sep 23, 2025@20:05:51 Page 2
GMPL31P ;SLC/JEH -- Post Install Routine ;3/1/05 11:00
+1 ;;2.0;Problem List;**31**;Aug 25, 1994
+2 ;
+3 ; This routine can be removed after installing patch
+4 ; GMPL*2*31 or kept and used as IRM tool
+5 QUIT
EN ;ENTRY POINT
+1 ;
+2 NEW IEN,TOTALWK,ADJUSTED
+3 SET IEN=0
+4 SET TOTALWK=0
+5 SET ADJUSTED=0
+6 WRITE !,"THE FOLLOWING PROBLEM LIST ENTRIES CONTAINED BAD ICD9 POINTERS"
+7 WRITE !,"AND HAVE BEEN MODIFIED WITH A CORRECTED POINTER",!
+8 WRITE !,"PROBLEM IEN BAD POINTER CORRECTED POINTER"
+9 WRITE !,"___________ ___________ _______________"
+10 FOR
SET IEN=$ORDER(^AUPNPROB(IEN))
if IEN=""
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^AUPNPROB(IEN,0)),"^")["-1"
Begin DoDot:2
+12 WRITE !,IEN,?16,$PIECE(^AUPNPROB(IEN,0),"^")
+13 SET $PIECE(^AUPNPROB(IEN,0),"^",1)=$PIECE($$NOS^GMPLX,"^",1)
+14 WRITE ?36,$PIECE(^AUPNPROB(IEN,0),"^",1)
+15 SET ADJUSTED=ADJUSTED+1
+16 QUIT
End DoDot:2
+17 IF $PIECE($GET(^AUPNPROB(IEN,0)),"^")["~"
Begin DoDot:2
+18 WRITE !,IEN,?16,$PIECE(^AUPNPROB(IEN,0),"^")
+19 SET $PIECE(^AUPNPROB(IEN,0),"^",1)=+$PIECE(^AUPNPROB(IEN,0),"^",1)
+20 WRITE ?36,$PIECE(^AUPNPROB(IEN,0),"^",1)
+21 SET ADJUSTED=ADJUSTED+1
End DoDot:2
+22 SET TOTALWK=TOTALWK+1
End DoDot:1
+23 WRITE !!,"TOTAL ITEMS WORKED = "_TOTALWK
+24 WRITE !,"TOTAL ITEMS ADJUSTED = "_ADJUSTED
+25 WRITE !!
+26 DO AUDTCLN
+27 QUIT
+28 ;
AUDTCLN ;
+1 NEW IEN,TOTALWK,ADJUSTED,HIT
+2 SET IEN=0
+3 SET TOTALWK=0
+4 SET ADJUSTED=0
+5 WRITE !,"THE FOLLOWING PROBLEM LIST AUDIT ENTRIES CONTAINED BAD ICD9 POINTERS"
+6 WRITE !,"AND HAVE BEEN MODIFIED WITH A CORRECTED POINTER",!
+7 WRITE !,"PROBLEM IEN BAD POINTER CORRECTED POINTER"
+8 WRITE !,"___________ ___________ _______________"
+9 FOR
SET IEN=$ORDER(^GMPL(125.8,IEN))
if IEN=""
QUIT
Begin DoDot:1
+10 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",2)'=.01
QUIT
+11 SET HIT=0
+12 ; look at the 5th piece
+13 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",5)["-1"
Begin DoDot:2
+14 WRITE !,IEN,?16,$PIECE(^GMPL(125.8,IEN,0),"^",5)
+15 SET $PIECE(^GMPL(125.8,IEN,0),"^",5)=$PIECE($$NOS^GMPLX,"^",1)
+16 WRITE ?36,$PIECE(^GMPL(125.8,IEN,0),"^",5)
+17 if HIT=0
SET ADJUSTED=ADJUSTED+1
SET HIT=1
+18 ;
End DoDot:2
+19 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",5)["~"
Begin DoDot:2
+20 WRITE !,IEN,?16,$PIECE(^GMPL(125.8,IEN,0),"^",5)
+21 SET $PIECE(^GMPL(125.8,IEN,0),"^",5)=+$PIECE(^GMPL(125.8,IEN,0),"^",5)
+22 WRITE ?36,$PIECE(^GMPL(125.8,IEN,0),"^",5)
+23 if HIT=0
SET ADJUSTED=ADJUSTED+1
SET HIT=1
+24 ;
End DoDot:2
+25 ; look at the 6th piece
+26 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",6)["-1"
Begin DoDot:2
+27 WRITE !,IEN,?16,$PIECE(^GMPL(125.8,IEN,0),"^",6)
+28 SET $PIECE(^GMPL(125.8,IEN,0),"^",6)=$PIECE($$NOS^GMPLX,"^",1)
+29 WRITE ?36,$PIECE(^GMPL(125.8,IEN,0),"^",6)
+30 if HIT=0
SET ADJUSTED=ADJUSTED+1
SET HIT=1
+31 ;
End DoDot:2
+32 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",6)["~"
Begin DoDot:2
+33 WRITE !,IEN,?16,$PIECE(^GMPL(125.8,IEN,0),"^",6)
+34 SET $PIECE(^GMPL(125.8,IEN,0),"^",6)=+$PIECE(^GMPL(125.8,IEN,0),"^",6)
+35 WRITE ?36,$PIECE(^GMPL(125.8,IEN,0),"^",6)
+36 if HIT=0
SET ADJUSTED=ADJUSTED+1
SET HIT=1
End DoDot:2
+37 SET TOTALWK=TOTALWK+1
End DoDot:1
+38 WRITE !!,"TOTAL AUDIT ITEMS WORKED = "_TOTALWK
+39 WRITE !,"TOTAL AUDIT ITEMS ADJUSTED = "_ADJUSTED
+40 WRITE !,"AN ITEM IEN MAY APPEAR UP TO 2 TIMES ONE FOR EACH BAD PIECE"
+41 WRITE !,"AS THE FIFTH AND SIXTH PIECES ARE CHECKED"
+42 QUIT
+43 ;
+44 ;
FIND ;
+1 ;find and display bad ICD9 pointers in Problem List ONLY
+2 NEW IEN,TOTALWK,ADJUSTED
+3 SET IEN=0
+4 SET TOTALWK=0
+5 SET ADJUSTED=0
+6 FOR
SET IEN=$ORDER(^AUPNPROB(IEN))
if IEN=""
QUIT
Begin DoDot:1
+7 SET TOTALWK=TOTALWK+1
+8 IF $PIECE($GET(^AUPNPROB(IEN,0)),"^")["-1"
WRITE !,IEN,?10,$PIECE(^AUPNPROB(IEN,0),"^")
SET ADJUSTED=ADJUSTED+1
QUIT
+9 IF $PIECE($GET(^AUPNPROB(IEN,0)),"^")["~"
WRITE !,IEN,?10,$PIECE(^AUPNPROB(IEN,0),"^")
SET ADJUSTED=ADJUSTED+1
End DoDot:1
+10 WRITE !,"TOTAL ITEMS LOOKED AT = "_TOTALWK
+11 WRITE !,"TOTAL BAD POINTERS FOUND = "_ADJUSTED
+12 QUIT
+13 ;
FDAUDIT ;
+1 ;finnd and display bad ICD9 pointer in the Audit file
+2 NEW IEN,TOTALWK,ADJUSTED
+3 SET IEN=0
+4 SET TOTALWK=0
+5 SET ADJUSTED=0
+6 FOR
SET IEN=$ORDER(^GMPL(125.8,IEN))
if IEN=""
QUIT
Begin DoDot:1
+7 SET TOTALWK=TOTALWK+1
+8 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^")["-1"
WRITE !,IEN,?10,$PIECE(^GMPL(125.8,IEN,0),"^")
SET ADJUSTED=ADJUSTED+1
QUIT
+9 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^")["~"
WRITE !,IEN,?10,$PIECE(^GMPL(125.8,IEN,0),"^")
SET ADJUSTED=ADJUSTED+1
+10 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",5)["-1"
WRITE !,IEN,?10,$PIECE(^GMPL(125.8,IEN,0),"^",5)
SET ADJUSTED=ADJUSTED+1
QUIT
+11 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",5)["~"
WRITE !,IEN,?10,$PIECE(^GMPL(125.8,IEN,0),"^",5)
SET ADJUSTED=ADJUSTED+1
+12 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",6)["-1"
WRITE !,IEN,?10,$PIECE(^GMPL(125.8,IEN,0),"^",6)
SET ADJUSTED=ADJUSTED+1
QUIT
+13 IF $PIECE($GET(^GMPL(125.8,IEN,0)),"^",6)["~"
WRITE !,IEN,?10,$PIECE(^GMPL(125.8,IEN,0),"^",6)
SET ADJUSTED=ADJUSTED+1
End DoDot:1
+14 WRITE !,"TOTAL ITEMS LOOKED AT = "_TOTALWK
+15 WRITE !,"TOTAL BAD POINTERS FOUND = "_ADJUSTED
+16 QUIT
