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

RMPR9AUT.m

Go to the documentation of this file.
  1. RMPR9AUT ;HINES IOFO/RVD - DETAILED PO RPC UTILITY ;09/16/03 13:12
  1. ;;3.0;PROSTHETICS;**90,116**;Feb 09, 1996
  1. ;input variables:
  1. ;DUZ = user
  1. ;RMPRSITE = pointer or IEN of file #669.9
  1. ;RESULTS = array of all PC number by a user.
  1. ;list PC number available to the user
  1. A1(DUZ,RMPRSITE) G A2
  1. ENA(RESULTS,DUZ,RMPRSITE) ;broker entry point to list all available PC number.
  1. A2 ;
  1. I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
  1. I +RMIFSITE'>0 S RESULTS(0)="IFCAP Site is undefined in #669.9" G EXIT1
  1. ;call IFCAP routine for the list of PC.
  1. D A1^PRCH7PA4(DUZ,RMIFSITE)
  1. S N="" F S N=$O(RESULTS(N)) Q:N="" D
  1. . I $P(RESULTS(N),U,11)="YES" K RESULTS(N) Q
  1. . S X=$P(RESULTS(N),U,13) D ^%DT
  1. . I Y'>DT K RESUTLS(N) Q
  1. EXIT1 ;exit
  1. Q
  1. ;
  1. ;create file 442.
  1. ;DUZ = user or initiator of an order
  1. ;RMPRSITE = pointer or IEN of file #669.9
  1. ;RESULTS = IEN of file #442 ^ PO number (e.g 499-PA1262)
  1. B1(DUZ,PRCSITE,RMPRSITE,PRCHXXX,PRCHVEN) G B2
  1. ENB(RESULTS,DUZ,PRCSITE,RMPRSITE,PRCHXXX,PRCHVEN,PRC4426) ;broker entry point
  1. B2 ;
  1. I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
  1. I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" G EXIT2
  1. ;call ITCAP routine to create a 442 entry.
  1. D AD1^PRCH7PA1(DUZ,RMIFSITE,RMPRSITE,PRCHXXX,PRCHVEN,PRC4426)
  1. ;
  1. EXIT2 ;
  1. Q
  1. ;
  1. ;List all Open detailed Purchased Order
  1. ;DUZ = user or initiator of an order
  1. ;RMPRSITE = pointer or IEN of file #669.9
  1. ;RESULTS = array of all open Detailed PO in file #664.
  1. C1(DUZ,RMPRSITE) G C2
  1. ENC(RESULTS,DUZ,RMPRSITE) ;broker entry point
  1. C2 ;
  1. S RMCNT=0
  1. F I=0:0 S I=$O(^RMPR(664,"H","DETAILED",I)) Q:I'>0 D
  1. .D GETS^DIQ(664,I,".01;.5;8","","RM")
  1. .Q:$G(RM(664,I_",",8))
  1. .S RMCNT=RMCNT+1
  1. .S RESULTS(RMCNT)=RM(664,I_",",.01)_U
  1. .S RESULTS(RMCNT)=RESULTS(RMCNT)_$G(RM(664,I_",",.5))_U
  1. Q
  1. ;
  1. ;List all Available Cost Center
  1. ;RMFCP = Fund Control Point
  1. ;RMPRSITE = pointer or IEN of file #669.9
  1. ;RESULTS = array of all Cost Center available in a given FCP.
  1. D1(RMFCP,RMPRSITE) G D2
  1. END(RESULTS,RMFCP,RMPRSITE) ;broker entry point
  1. D2 ;
  1. I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
  1. I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
  1. ;access IFCAP API to list available Cost center.
  1. D B1^PRCH7PA4(RMFCP,RMIFSITE)
  1. Q
  1. ;
  1. ;List all Available BOC
  1. ;RMCC = Cost Center
  1. ;RMPRSITE = pointer or IEN of file #669.9
  1. ;RESULTS = array of all available BOC in a given Cost Center.
  1. E1(RMCC,RMPRSITE) G E2
  1. ENE(RESULTS,RMCC,RMPRSITE) ;broker entry point
  1. E2 ;
  1. I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
  1. I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
  1. ;access IFCAP API to list available Budget Object Code.
  1. D C1^PRCH7PA4(RMCC,RMIFSITE)
  1. Q
  1. ;
  1. ;List all Available FCP
  1. ;DUZ = user
  1. ;RMPRSITE = pointer or IEN of file #669.9
  1. ;RESULTS = array of all available FCP in a given station.
  1. F1(DUZ,RMPRSITE) G F2
  1. ENF(RESULTS,DUZ,RMPRSITE) ;broker entry point
  1. F2 ;
  1. I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
  1. I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
  1. ;access IFCAP API to list available Fund control Point.
  1. D D1^PRCH7PA4(DUZ,RMIFSITE)
  1. Q
  1. ;
  1. ;Broker call to link suspense to 2319
  1. ;RMPR64 = ien of file #664
  1. ;RMPR68 = ien of file #668
  1. ;RESULTS = success or failure message.
  1. G1(RMPR64,RMPR68) G G2
  1. ENG(RESULTS,RMPR64,RMPR68) ;broker entry point
  1. G2 ;
  1. N RMAMIS,RMIDAT,RMIEN60,RMERCHK,RMAR
  1. S RESULTS=""
  1. ;do automatic linking to suspense.
  1. ;loop all the item and get the pointer to 660.
  1. F I=0:0 S I=$O(^RMPR(664,RMPR64,1,I)) Q:(I'>0)!(RESULTS'="") D
  1. .S RMIDAT=$G(^RMPR(664,RMPR64,1,I,0))
  1. .S RMIEN60=$P(RMIDAT,U,13)
  1. .Q:'$G(RMIEN60)
  1. .S RMAMIS=""
  1. .I $D(^RMPR(660,RMIEN60,"AMS")) S RMAMIS=$G(^RMPR(660,RMIEN60,"AMS"))
  1. .Q:'$G(RMAMIS)
  1. .S RMERCHK=0
  1. .S RMERCHK=$$UP60^RMPRPCE1(RMIEN60,RMPR68,1)
  1. .I $G(RMERCHK) S RESULTS="Error Linking to file #660" Q
  1. .S RMERCHK=$$UP68^RMPRPCE1(RMIEN60,RMPR68,RMAMIS)
  1. .I $G(RMERCHK) S RESULTS="Error Linking to file #668" Q
  1. I RESULTS="" S RESULTS="PCE linking to suspense is complete"
  1. Q
  1. ;
  1. ;Broker call to list vendor.
  1. ;RMPR40 = ien of file #440
  1. ;RESULTS = success or failure message.
  1. H1(RMPR40,RMPRSITE) G H2
  1. ENH(RESULTS,RMPR40,RMPRSITE) ;broker entry point
  1. H2 ;
  1. I $D(^RMPR(669.9,RMPRSITE,4)) S RMIFSITE=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
  1. I '$D(RMIFSITE) S RESULTS(0)="IFCAP Site is undefined in #669.9" Q
  1. ;call ifcap API for vendor listing.
  1. D E1^PRCH7PA4(RMPR40)
  1. Q
  1. ;broker call to ask for electronic signature code
  1. ;DUZ - user IEN
  1. ;X - electronic code entered by user.
  1. ;RESULTS - failure or success message.
  1. I1(DUZ,X) G I2
  1. ENI(RESULTS,DUZ,X) ;broker entry point
  1. I2 ;
  1. N RMCODE
  1. S RMCODE=$P($G(^VA(200,DUZ,20)),"^",4)
  1. I RMCODE="" S RESULTS="You have no signature code on file." Q
  1. ;W !,"Enter Electronic signature Code: "
  1. ;X ^%ZOSF("EOFF") R X:60 X ^%ZOSF("EON")
  1. ;I '$T S RESULTS="Failure" Q
  1. I $E(X)="^" S RESULTS="User up arrowed out." Q
  1. S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. I $$HASH(X)=RMCODE S RESULTS="Thank you." Q
  1. S RESULTS="Sorry, but that's not your correct electronic signature code."
  1. Q
  1. HASH(X) D HASH^XUSHSHP
  1. Q X
  1. ;END