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

ORD21.m

Go to the documentation of this file.
  1. ORD21 ; COMPILED XREF FOR FILE #100 ; 06/29/23
  1. ;
  1. S DIKZK=2
  1. S DIKZ(0)=$G(^OR(100,DA,0))
  1. S X=$P($G(DIKZ(0)),U,2)
  1. I X'="" D KILALL^ORDD100(DA)
  1. S X=$P($G(DIKZ(0)),U,2)
  1. I X'="" X ^DD(100,.02,1,5,2)
  1. S X=$P($G(DIKZ(0)),U,2)
  1. I X'="" X ^DD(100,.02,1,7,2)
  1. S X=$P($G(DIKZ(0)),U,2)
  1. I X'="" D WK^ORDD100
  1. S X=$P($G(DIKZ(0)),U,2)
  1. I X'="" D OI2^ORDD100A(DA)
  1. S X=$P($G(DIKZ(0)),U,2)
  1. I X'="" X ^DD(100,.02,1,11,2)
  1. S DIKZ(.61)=$G(^OR(100,DA,.61))
  1. S X=$P($G(DIKZ(.61)),U,1)
  1. I X'="" K ^OR(100,"E",$E(X,1,30),DA)
  1. S DIKZ(0)=$G(^OR(100,DA,0))
  1. S X=$P($G(DIKZ(0)),U,5)
  1. I X'="" K ^OR(100,"C",$E(X,1,30),DA)
  1. S DIKZ(3)=$G(^OR(100,DA,3))
  1. S X=$P($G(DIKZ(3)),U,4)
  1. I X'="" K ^OR(100,"D",$E(X,1,30),DA)
  1. S X=$P($G(DIKZ(0)),U,8)
  1. I X'="" D SK^ORDD100
  1. S X=$P($G(DIKZ(0)),U,8)
  1. I X'="" D WK^ORDD100
  1. S X=$P($G(DIKZ(0)),U,8)
  1. I X'="" D OI2^ORDD100A(DA)
  1. S X=$P($G(DIKZ(0)),U,9)
  1. I X'="" D EK^ORDD100A
  1. S X=$P($G(DIKZ(0)),U,11)
  1. I X'="" D WK^ORDD100
  1. S X=$P($G(DIKZ(0)),U,11)
  1. I X'="" X ^DD(100,23,1,3,2)
  1. CR1 S DIXR=187
  1. K X
  1. S DIKZ(0)=$G(^OR(100,DA,0))
  1. S X(1)=$P(DIKZ(0),U,2)
  1. S X(2)=$P(DIKZ(0),U,17)
  1. S X=$G(X(1))
  1. I $G(X(1))]"",$G(X(2))]"" D
  1. . K X1,X2 M X1=X,X2=X
  1. . S:$D(DIKIL) (X2,X2(1),X2(2))=""
  1. . K ^OR(100,"AEVNT",X(1),X(2),DA)
  1. CR2 S DIXR=210
  1. K X
  1. S DIKZ(0)=$G(^OR(100,DA,0))
  1. S X(1)=$P(DIKZ(0),U,2)
  1. S DIKZ(7)=$G(^OR(100,DA,7))
  1. S X=$P(DIKZ(7),U,1)
  1. I $G(X)]"" S X=9999999-X
  1. S:$D(X)#2 X(2)=X
  1. S X=$G(X(1))
  1. I $G(X(1))]"",$G(X(2))]"" D
  1. . K X1,X2 M X1=X,X2=X
  1. . S:$D(DIKIL) (X2,X2(1),X2(2))=""
  1. . K ^OR(100,"ARS",X(1),X(2),DA)
  1. CR3 K X
  1. END G ^ORD22