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