| 1 | RMPRET ;Hines-OI/HNC - ITEM SERVER ;01/14/2005
|
|---|
| 2 | ;;3.0;PROSTHETICS;**103**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;DBIA # 10072 - for routine REMSBMSG^XMA1C
|
|---|
| 5 | ;
|
|---|
| 6 | EN ;Entry Point
|
|---|
| 7 | ;HCPCS SERVER
|
|---|
| 8 | ;
|
|---|
| 9 | ;K ^TMP($J)
|
|---|
| 10 | X XMREC D
|
|---|
| 11 | .;check
|
|---|
| 12 | .S RMPRWHO3=XMRG
|
|---|
| 13 | .X XMREC S RMPRWHO1=XMRG
|
|---|
| 14 | .X XMREC S RMPRWHO2=XMRG
|
|---|
| 15 | .S RMPRWHO=$$DEC^RMPR4LI(RMPRWHO3,RMPRWHO1,RMPRWHO2)
|
|---|
| 16 | .S RMPRCHK=0
|
|---|
| 17 | .F S RMPRCHK=$O(^RMPR(669.9,RMPRCHK)) Q:RMPRCHK>0
|
|---|
| 18 | .I RMPRWHO'=$P(^RMPR(669.9,RMPRCHK,"INV"),U,4) D NOGO Q
|
|---|
| 19 | D NOW^%DTC S RMPRWHN=%
|
|---|
| 20 | S CNT=6,RMPRDLM=","_"""I"""
|
|---|
| 21 | S (RMPRIEN,RMPRFLD,RMPRVL,RMPRIEN2)=""
|
|---|
| 22 | F X XMREC Q:XMRG="" D
|
|---|
| 23 | .;S RMPRMSG(CNT+10000)=$P(XMRG,RMPRDLM,1)_$P(XMRG,RMPRDLM,2)
|
|---|
| 24 | .S RMPRIEN=$P(XMRG,U,1)
|
|---|
| 25 | .S RMPRFLD=$P(XMRG,U,2)
|
|---|
| 26 | .S RMPRVL=$P(XMRG,U,3)
|
|---|
| 27 | .S RMPRIEN2=$P(XMRG,U,4)
|
|---|
| 28 | .I RMPRFLD=.01 S RMPRMSG(CNT)="HCPCS: "_RMPRVL
|
|---|
| 29 | .;S ^TMP($J,RMPRIEN,RMPRFLD)=RMPRVL
|
|---|
| 30 | .;check to see if new and add
|
|---|
| 31 | .I '$D(^RMPR(661.1,RMPRIEN)) D
|
|---|
| 32 | . .S $P(^RMPR(661.1,RMPRIEN,0),U,1)=RMPRVL
|
|---|
| 33 | . .S DIK="^RMPR(661.1,"
|
|---|
| 34 | . .S DA=RMPRIEN D IX1^DIK
|
|---|
| 35 | .S UPD(661.1,RMPRIEN_",",1.1)=RMPRWHN
|
|---|
| 36 | .S UPD(661.1,RMPRIEN_",",1.2)=XMFROM
|
|---|
| 37 | .I RMPRFLD="661.18" D
|
|---|
| 38 | . .;START DESCRIPTION
|
|---|
| 39 | . .S ^RMPR(661.1,RMPRIEN,2,RMPRIEN2,0)=RMPRVL
|
|---|
| 40 | . .S CNTIEN=0,CNTIEN1=0
|
|---|
| 41 | . .F S CNTIEN=$O(^RMPR(661.1,RMPRIEN,2,CNTIEN)) Q:CNTIEN'>0 D
|
|---|
| 42 | . . .S CNTIEN1=CNTIEN1+1
|
|---|
| 43 | . .S ^RMPR(661.1,RMPRIEN,2,0)="^661.18^"_CNTIEN1_U_CNTIEN1
|
|---|
| 44 | . .S DIK="^RMPR(661.1,"
|
|---|
| 45 | . .S DA=RMPRIEN D IX1^DIK
|
|---|
| 46 | . .S RMPRFLD=""
|
|---|
| 47 | .I RMPRFLD="" Q
|
|---|
| 48 | .I RMPRFLD'=.01 S UPD(661.1,RMPRIEN_",",RMPRFLD)=RMPRVL
|
|---|
| 49 | .S CNT=CNT+1
|
|---|
| 50 | D FILE^DIE("","UPD","ERROR")
|
|---|
| 51 | I $D(ERROR("DIERR")) S RMPRMSG(1.1)="******* ERROR ENCOUNTERED*******"
|
|---|
| 52 | S XMDUZ=.5
|
|---|
| 53 | S XMY("G.RMPR SERVER")=""
|
|---|
| 54 | S XMY("VHACOPSASPIPReport@med.va.gov")=""
|
|---|
| 55 | S XMSUB="PSAS HCPCS Item Server Update "_$P($$SITE^VASITE,U,2)
|
|---|
| 56 | S RMPRMSG(1)="The National PSAS Item Server has been activated today by Prosthetics HQ."
|
|---|
| 57 | S RMPRMSG(2)="Please print your HCPCS Mapping File."
|
|---|
| 58 | S RMPRMSG(3)=""
|
|---|
| 59 | S RMPRMSG(4)="This was activated by "_$P(XMFROM,"@",1)
|
|---|
| 60 | S RMPRMSG(5)=""
|
|---|
| 61 | S XMTEXT="RMPRMSG("
|
|---|
| 62 | D ^XMD
|
|---|
| 63 | G EXIT
|
|---|
| 64 | Q
|
|---|
| 65 | NOGO ;message not valid
|
|---|
| 66 | S XMDUZ=.5
|
|---|
| 67 | S XMY("G.RMPR SERVER")=""
|
|---|
| 68 | S XMY("VHACOPSASPIPReport@med.va.gov")=""
|
|---|
| 69 | S XMSUB="**ERROR** Not Authorized HCPCS Item Server Update From "_$P($$SITE^VASITE,U,2)
|
|---|
| 70 | S RMPRMSG(1)="The National PSAS Item Server was unsuccessful today."
|
|---|
| 71 | S RMPRMSG(2)="****ERROR**** Not Authorized!"
|
|---|
| 72 | S RMPRMSG(3)=""
|
|---|
| 73 | S RMPRMSG(4)="This was activated by "_XMFROM
|
|---|
| 74 | S XMTEXT="RMPRMSG("
|
|---|
| 75 | D ^XMD
|
|---|
| 76 | ;
|
|---|
| 77 | EXIT ;common exit point
|
|---|
| 78 | S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
|
|---|
| 79 | K %,CNT,DA,DIK,ERROR,RMPRDL,RMPRFLD,RMPRIEN2,RMPRMSG,RMPRVL,RMPRWHN
|
|---|
| 80 | K UPD,XMDUZ,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,RMPRIEN,RMPRDLM,CNTIEN,CNTIEN1
|
|---|
| 81 | K RMPRWHO,RMPRWHO1,RMPRWHO2,RMPRWHO3,XMSER,RMPRCHK,XMZ,XQMSG,XQSOP
|
|---|
| 82 | ;END
|
|---|
