- 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 Jan 18, 2025@03:34:37 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