Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRN6XM

RMPRN6XM.m

Go to the documentation of this file. 
  1. RMPRN6XM ;Hines OIFO/HNC - NPPD Auto-Fix ;9/16/02  11:14
  1.  ;;3.0;PROSTHETICS;**70,90**;Feb 09, 1996
  1.  Q
  1. TASK ;main entry point
  1.  ;look at file 660, field #2 Type.
  1.  ;this will need to be updated with 1=new and 2=repair.
  1.  ;
  1.  ;"I" = initial issue = new
  1.  ;"R" = replace = new
  1.  ;"S" = spare = new
  1.  ;"X" = repair = repair
  1.  ; 5  = rental = repair added with patch 90
  1.  ;
  1.  K ^TMP($J)
  1.  S B=0,LINE=""
  1.  F  S B=$O(^RMPR(660,B)) Q:B'>0  D
  1.  .S TYPE=$P($G(^RMPR(660,B,0)),U,4)
  1.  .I TYPE=5 Q  ;No change if Rental just quit.
  1.  .;if type is null, then Home Oxygen Posted with no type, and that is
  1.  .;a repair NPPD line. Or, shipping and that is repair.
  1.  .I TYPE="" S TYPE="X"
  1.  .S PHCPCS=$P($G(^RMPR(660,B,1)),U,4)
  1.  .;junk in the global - alpha
  1.  .Q:PHCPCS'>0
  1.  .Q:PHCPCS=""
  1.  .I TYPE'="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7)
  1.  .I LINE="" D
  1.  .    .S ERR=""
  1.  .    .S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6)
  1.  .    .S TYPE="X"
  1.  .    .S DIE="^RMPR(660,",DA=B,DR="2///^S X=TYPE"
  1.  .    .L +^RMPR(660,B):1 I '$T S ERR=1
  1.  .    .W !,B,"  ",ERR
  1.  .    .I ERR=1 S ^TMP($J,"RMPRA",B)="NO UPDATE!"
  1.  .    .I ERR="" D ^DIE L -^RMPR(660,B)
  1.  .    .K DIE,DA,DR
  1.  .    .I ERR="" S ^TMP($J,"RMPRA",B)="NEW TO REPAIR"
  1.  .    .D DATA
  1.  .I TYPE="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6)
  1.  .I LINE="" D
  1.  .    .S ERR=""
  1.  .    .S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7)
  1.  .    .S TYPE="I"
  1.  .    .S DIE="^RMPR(660,",DA=B,DR="2///^S X=TYPE"
  1.  .    .L +^RMPR(660,B):1 I '$T S ERR=1
  1.  .    .I ERR=1 S ^TMP($J,"RMPRA",B)="NO UPDATE!"
  1.  .    .I ERR="" D ^DIE L -^RMPR(660,B)
  1.  .    .K DIE,DA,DR
  1.  .    .I ERR="" S ^TMP($J,"RMPRA",B)="REPAIR TO NEW "
  1.  .    .D DATA
  1.  K B,LINE,PHCPCS,TYPE
  1.  D FMT
  1.  I $D(^TMP($J,"RMPR")) D MAIL
  1.  G EXIT
  1.  Q
  1. DATA ;delimited tmp with data
  1.  D GETS^DIQ(660,B,".01;.02;4.5;5;7;8.3;14;4;24;27","","RMXM")
  1.  S $P(^TMP($J,"RMPRA",B),U,2)=$G(RMXM(660,B_",",.01))
  1.  S $P(^TMP($J,"RMPRA",B),U,3)=$G(RMXM(660,B_",",.02))
  1.  S $P(^TMP($J,"RMPRA",B),U,4)=$G(RMXM(660,B_",",4.5))
  1.  S $P(^TMP($J,"RMPRA",B),U,5)=$G(RMXM(660,B_",",5))
  1.  S $P(^TMP($J,"RMPRA",B),U,6)=$G(RMXM(660,B_",",7))
  1.  S $P(^TMP($J,"RMPRA",B),U,7)=$G(RMXM(660,B_",",8.3))
  1.  S $P(^TMP($J,"RMPRA",B),U,8)=$G(RMXM(660,B_",",14))
  1.  S $P(^TMP($J,"RMPRA",B),U,9)=$G(RMXM(660,B_",",4))
  1.  S $P(^TMP($J,"RMPRA",B),U,10)=$G(RMXM(660,B_",",27))
  1.  S $P(^TMP($J,"RMPRA",B),U,11)=LINE
  1.  S $P(^TMP($J,"RMPRA",B),U,12)=$G(RMXM(660,B_",",24))
  1.  K RMXM
  1.  Q
  1. FMT ;format the records for report display
  1.  S B=0,^TMP($J,"RMPRFMT")="",CNT=0
  1.  F  S B=$O(^TMP($J,"RMPRA",B)) Q:B'>0  D
  1.  .S DATA=^TMP($J,"RMPRA",B)
  1.  .S (B1,BX,B3,B4,B5,B6,B7,B8)=""
  1.  .S B2="^TMP($J,""RMPRFMT"")"
  1.  .S B1=$$SETSTR^VALM1($P(DATA,U,1),@B2,1,14)
  1.  .S BX=$$SETSTR^VALM1($P(DATA,U,2),@B2,1,14)
  1.  .S B3=$$SETSTR^VALM1($P(DATA,U,3),@B2,1,11)
  1.  .S B4=$$SETSTR^VALM1($P(DATA,U,4),@B2,1,6)
  1.  .S B5=$$SETSTR^VALM1($P(DATA,U,9),@B2,1,10)
  1.  .S B6=$$SETSTR^VALM1($P(DATA,U,6),@B2,2,11)
  1.  .S B7=$$SETSTR^VALM1($P(DATA,U,10),@B2,2,12)
  1.  .S OLDLN=$P(DATA,U,1)
  1.  .I OLDLN["REPAIR TO NEW" S OLDLN="R99 X"
  1.  .I OLDLN["NEW TO REPAIR" S OLDLN="999 X"
  1.  .I OLDLN["NO UPDATE!" S OLDLN="????"
  1.  .;
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)=B1
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)="Create Date   Patient    HCPCS Item       Vendor      PA"
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)=BX_B3_B4_B8_B5_B6_B7
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)=""
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)="Brief Description: "_$P(DATA,U,12)
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)=""
  1.  .S CNT=CNT+1
  1.  .I OLDLN'="????" S ^TMP($J,"RMPR",CNT)="Changed From Line "_OLDLN_" To NPPD Line: "_$P(DATA,U,11)_"  Local Record #:"_B
  1.  .I OLDLN="????" S ^TMP($J,"RMPR",CNT)="Nothing Changed, Someone Was Editing Record.  Local Record #:"_B
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,"RMPR",CNT)="-------------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1. MAIL ;send report via message to mail group RMPR INVENTORY
  1.  ;
  1.  S XMY("G.RMPR INVENTORY")=""
  1.  S XMDUZ=.5
  1.  S XMTEXT="^TMP($J,""RMPR"","
  1.  S XMSUB="Prosthetics Auto-Fix"
  1.  D ^XMD
  1.  Q
  1.  ;
  1. EXIT ;common exit point
  1.  K ^TMP($J,"RMPRA"),^TMP($J,"RMPR")
  1.  Q
  1.  ;END