RMPFQM1 ;DDC/KAW-CONTINUATION OF RMPFQM [ 03/27/98  2:00 PM ]
 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8,10,16**;MAY 30, 1995
LOAD S SX=XMRG,NM=$P(SX,U,1) S ST="" F IK=1:1:78 S ST=ST_" "
 Q:NM'?3N.E7N.E  K RMPFX D  Q:'$D(RMPFX)
 .S RMPFX=$P(SX,U,2) I 'RMPFX K RMPFX Q
 .I '$D(^RMPF(791810,RMPFX,0)) K RMPFX Q
 .I '$D(^RMPF(791810,RMPFX,201,0)) S ^RMPF(791810,RMPFX,201,0)="^791810.0201"
 .S X="NOW",%DT="T" D ^%DT S TD=Y
 .S DIC="^RMPF(791810,"_RMPFX_",201,",DIC(0)="L",DLAYGO=791810
 .S X=MD,DA(1)=RMPFX K DD,DO D FILE^DICN I Y=-1 K RMPFX Q
 .S FY=+Y,$P(^RMPF(791810,RMPFX,201,FY,0),U,2)=XMZ
 .D BLANK
 .S SM=^RMPF(791810,RMPFX,0),X=$P(SM,U,2)
 .I X,$D(^RMPF(791810.1,X,0)) S RMPFTYP=$E(($P(^(0),U,8)_"      "),1,6),RMPFHAT=$P(^(0),U,2)
 .S X=$P(SM,U,4) I X S DFN=X D DEM^VADPT S Y=$E($P(VADM(2),U,1),1,15),RMPFNAM=$E(($P(VADM(1),U,1)_"                    "),1,15)_"-"_$E((Y_"    "),6,9)
LINEI F IX=1:1 X XMREC Q:XMER=-1  S SX=XMRG,X=$P(SX,U,1) D  Q:'$D(RMPFX)
 .I X?3N.E D:X=301 AUTH S XMPOS=XMPOS-1 K RMPFX Q
 .I '$D(^RMPF(791810,RMPFX,201,FY,101,0)) S ^RMPF(791810,RMPFX,201,FY,101,0)="^791810.201101^^"
 .S DIC="^RMPF(791810,"_RMPFX_",201,"_FY_",101,",DA(2)=RMPFX
 .S DA(1)=FY,DIC(0)="L",DLAYGO=791810,X=$P(SX,U,1)
 .K DD,DO D FILE^DICN
 .Q:Y=-1
 .S X=$P(SX,U,9) I X'="" S $P(^RMPF(791810,RMPFX,0),U,7)=X,^RMPF(791810,"D",X,RMPFX)=""
 .S $P(^RMPF(791810,RMPFX,201,FY,101,+Y,0),U,2,99)=$P(SX,U,2,99),$P(^(0),U,7)=""
 .S X=$P(SX,U,1) I X["STATUS COMPLETE"!(X["ORDER PLACED")!(X["CANCELED")!(X["CERTIFICATION PROCESSED") S $P(^RMPF(791810,RMPFX,201,FY,101,+Y,0),U,6)=1
 .S RMPFST=$P(SX,U,4),RMPFY=$P(SX,U,8)
 .I RMPFY,RMPFHAT="I",$P($G(^RMPF(791810,RMPFX,101,RMPFY,90)),U,10),$P(^(0),U,8) S RMPFST=$O(^RMPF(791810.2,"B","COMPLETE",0))
 .I RMPFST D
 ..I $D(^RMPF(791810.2,RMPFST,0)) S RMPFSTP=$E(($P(^(0),U,4)_"      "),1,6)
 ..S Y=$P(SX,U,10)
 ..I Y?7N S RMPFSB=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
 ..I RMPFY S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DA=RMPFY,DR=".18////"_RMPFST_";.17////"_TD S:RMPFST=11 DR=DR_";.15////C" D ^DIE
 ..I RMPFST=6!(RMPFST=10),'RMPFY S DA=0 F  S DA=$O(^RMPF(791810,RMPFX,101,DA)) Q:'DA  S DIE="^RMPF(791810,"_RMPFX_",101,",DR=".18////"_RMPFST_";.2////1" D ^DIE
 ..I RMPFST=6!(RMPFST=10) D REMOV^RMPFET10
 ..I RMPFST=17,RMPFHAT="C" S DIE="^RMPF(791810,",DA=RMPFX,DR=".02////5" D ^DIE
 ..S SC=$P($G(^RMPF(791810.2,RMPFST,0)),U,5) S:SC="" SC="E"
 ..I SC="E" D SETORD Q
 ..D ARRAY^RMPFDT2 S (E,P,X)=0
 ..F  S X=$O(RMPFO(X)) Q:'X  D
 ...S Y=RMPFO(X) Q:'Y  Q:'$D(^RMPF(791810.2,Y,0))  S SC=$P(^(0),U,5) Q:SC=""
 ...I SC="E" S E=Y Q
 ...I SC="P" S P=Y
 ..I E>0 S RMPFST=E D SETORD Q
 ..I P>0 S RMPFST=P
 ..D SETORD
 .I $D(RMPFY),RMPFY,$D(^RMPF(791810,RMPFX,101,RMPFY,0)) S S0=^(0)  D
 ..S IT=$P(S0,U,1) Q:'IT
 ..I IT=1 S RMPFITP=$P($G(^RMPF(791810,RMPFX,101,RMPFY,2)),U,2)
 ..E  S RMPFITP=$P($G(^RMPF(791811,IT,0)),U,1)
 ..S RMPFITP=$E(RMPFITP_"                              ",1,30)
 .S CT=CT+1,XQSTXT(CT)=RMPFNAM_"  "_RMPFTYP_"  "_RMPFSTP_"  "_RMPFITP_" "_RMPFSB
 .D BLANK Q
 Q
AUTH K ^RMPF(791810,RMPFX,301)
 S ^RMPF(791810,RMPFX,301,0)="^791810.0301",CY=1,XMPOS=XMPOS-1
 F IY=1:1 X XMREC Q:XMER=-1  S X=$P(XMRG,U,1),SX=$P(XMRG,U,2,99) D  Q:X'=301
 .I X'=301 S XMPOS=XMPOS-1 Q
 .S ^RMPF(791810,RMPFX,301,CY,0)=SX
 .S ^RMPF(791810,RMPFX,301,"B",$P(SX,U,1),CY)="",CY=CY+1
 Q
SETORD S DIE="^RMPF(791810,",DA=RMPFX,DR=".03////"_RMPFST D ^DIE Q
BLANK S RMPFNAM="                    "
 S (RMPFSTP,RMPFTYP)="      "
 S RMPFITP="                              "
 S RMPFSB="        "
 Q