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