- DGMTXX31 ; COMPILED XREF FOR FILE #408.31 ; 10/15/12
- ;
- S DIKZK=2
- S DIKZ(0)=$G(^DGMT(408.31,DA,0))
- S X=$P($G(DIKZ(0)),U,19)
- I X'="" K ^DGMT(408.31,"AS",X,+$P(^DGMT(408.31,DA,0),U,3),-$P(^(0),U),+$P(^(0),U,2),DA)
- S X=$P($G(DIKZ(0)),U,19)
- I X'="" K ^DGMT(408.31,"AID",X,+$P(^DGMT(408.31,DA,0),U,2),-$P(^(0),U),DA)
- S X=$P($G(DIKZ(0)),U,19)
- I X'="" K ^DGMT(408.31,"AD",X,+$P(^DGMT(408.31,DA,0),U,2),$P(^(0),U),DA)
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" K ^DGMT(408.31,"AS",+$P(^DGMT(408.31,DA,0),U,19),+$P(^(0),U,3),-$P(^(0),U),X,DA)
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" K ^DGMT(408.31,"AID",+$P(^DGMT(408.31,DA,0),U,19),X,-$P(^(0),U),DA)
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" K ^DGMT(408.31,"C",$E(X,1,30),DA)
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" K ^DGMT(408.31,"AD",+$P(^DGMT(408.31,DA,0),U,19),X,$P(^(0),U),DA)
- S X=$P($G(DIKZ(0)),U,2)
- I X'="" K ^DGMT(408.31,"ADFN"_X,+^DGMT(408.31,DA,0),DA)
- S X=$P($G(DIKZ(0)),U,3)
- I X'="" K ^DGMT(408.31,"AS",+$P(^DGMT(408.31,DA,0),U,19),X,-$P(^(0),U),+$P(^(0),U,2),DA)
- S X=$P($G(DIKZ(0)),U,3)
- I X'="" D CUR^DGMTDD
- S X=$P($G(DIKZ(0)),U,7)
- I X'="" K ^DGMT(408.31,"AG",$E(X,1,30),DA)
- S X=$P($G(DIKZ(0)),U,11)
- I X'="" D:$G(DGMTYPT)<3 AUTOUPD^DGENA2(+$P(^DGMT(408.31,DA,0),U,2),2)
- S X=$P($G(DIKZ(0)),U,16)
- I X'="" K ^DGMT(408.31,"AP",X,$P(^DGMT(408.31,DA,0),U),DA)
- S X=$P($G(DIKZ(0)),U,20)
- I X'="" K ^DGMT(408.31,"AE",$E(X,1,30),DA)
- S X=$P($G(DIKZ(0)),U,20)
- I X'="" S:'$P(^DGMT(408.31,DA,0),U,20) $P(^DGMT(408.31,DA,0),U,21,22)="^"
- S DIKZ(2)=$G(^DGMT(408.31,DA,2))
- S X=$P($G(DIKZ(2)),U,2)
- I X'="" D E40831^DGRTRIG(DA)
- S X=$P($G(DIKZ(2)),U,3)
- I X'="" D STOPAUTO^DGMTDD(DA)
- S X=$P($G(DIKZ(2)),U,8)
- I X'="" K ^DGMT(408.31,"AT",$E(X,1,30),DA)
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" K ^DGMT(408.31,"B",$E(X,1,30),DA)
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" K ^DGMT(408.31,"AS",+$P(^DGMT(408.31,DA,0),U,19),+$P(^(0),U,3),-X,+$P(^(0),U,2),DA)
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" K ^DGMT(408.31,"AID",+$P(^DGMT(408.31,DA,0),U,19),+$P(^(0),U,2),-X,DA)
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" K ^DGMT(408.31,"AD",+$P(^DGMT(408.31,DA,0),U,19),+$P(^(0),U,2),X,DA)
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" K ^DGMT(408.31,"ADFN"_$P(^DGMT(408.31,DA,0),U,2),X,DA)
- END Q
- DGMTXX31 ; COMPILED XREF FOR FILE #408.31 ; 10/15/12
- +1 ;
- +2 SET DIKZK=2
- +3 SET DIKZ(0)=$GET(^DGMT(408.31,DA,0))
- +4 SET X=$PIECE($GET(DIKZ(0)),U,19)
- +5 IF X'=""
- KILL ^DGMT(408.31,"AS",X,+$PIECE(^DGMT(408.31,DA,0),U,3),-$PIECE(^(0),U),+$PIECE(^(0),U,2),DA)
- +6 SET X=$PIECE($GET(DIKZ(0)),U,19)
- +7 IF X'=""
- KILL ^DGMT(408.31,"AID",X,+$PIECE(^DGMT(408.31,DA,0),U,2),-$PIECE(^(0),U),DA)
- +8 SET X=$PIECE($GET(DIKZ(0)),U,19)
- +9 IF X'=""
- KILL ^DGMT(408.31,"AD",X,+$PIECE(^DGMT(408.31,DA,0),U,2),$PIECE(^(0),U),DA)
- +10 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +11 IF X'=""
- KILL ^DGMT(408.31,"AS",+$PIECE(^DGMT(408.31,DA,0),U,19),+$PIECE(^(0),U,3),-$PIECE(^(0),U),X,DA)
- +12 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +13 IF X'=""
- KILL ^DGMT(408.31,"AID",+$PIECE(^DGMT(408.31,DA,0),U,19),X,-$PIECE(^(0),U),DA)
- +14 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +15 IF X'=""
- KILL ^DGMT(408.31,"C",$EXTRACT(X,1,30),DA)
- +16 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +17 IF X'=""
- KILL ^DGMT(408.31,"AD",+$PIECE(^DGMT(408.31,DA,0),U,19),X,$PIECE(^(0),U),DA)
- +18 SET X=$PIECE($GET(DIKZ(0)),U,2)
- +19 IF X'=""
- KILL ^DGMT(408.31,"ADFN"_X,+^DGMT(408.31,DA,0),DA)
- +20 SET X=$PIECE($GET(DIKZ(0)),U,3)
- +21 IF X'=""
- KILL ^DGMT(408.31,"AS",+$PIECE(^DGMT(408.31,DA,0),U,19),X,-$PIECE(^(0),U),+$PIECE(^(0),U,2),DA)
- +22 SET X=$PIECE($GET(DIKZ(0)),U,3)
- +23 IF X'=""
- DO CUR^DGMTDD
- +24 SET X=$PIECE($GET(DIKZ(0)),U,7)
- +25 IF X'=""
- KILL ^DGMT(408.31,"AG",$EXTRACT(X,1,30),DA)
- +26 SET X=$PIECE($GET(DIKZ(0)),U,11)
- +27 IF X'=""
- IF $GET(DGMTYPT)<3
- DO AUTOUPD^DGENA2(+$PIECE(^DGMT(408.31,DA,0),U,2),2)
- +28 SET X=$PIECE($GET(DIKZ(0)),U,16)
- +29 IF X'=""
- KILL ^DGMT(408.31,"AP",X,$PIECE(^DGMT(408.31,DA,0),U),DA)
- +30 SET X=$PIECE($GET(DIKZ(0)),U,20)
- +31 IF X'=""
- KILL ^DGMT(408.31,"AE",$EXTRACT(X,1,30),DA)
- +32 SET X=$PIECE($GET(DIKZ(0)),U,20)
- +33 IF X'=""
- IF '$PIECE(^DGMT(408.31,DA,0),U,20)
- SET $PIECE(^DGMT(408.31,DA,0),U,21,22)="^"
- +34 SET DIKZ(2)=$GET(^DGMT(408.31,DA,2))
- +35 SET X=$PIECE($GET(DIKZ(2)),U,2)
- +36 IF X'=""
- DO E40831^DGRTRIG(DA)
- +37 SET X=$PIECE($GET(DIKZ(2)),U,3)
- +38 IF X'=""
- DO STOPAUTO^DGMTDD(DA)
- +39 SET X=$PIECE($GET(DIKZ(2)),U,8)
- +40 IF X'=""
- KILL ^DGMT(408.31,"AT",$EXTRACT(X,1,30),DA)
- +41 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +42 IF X'=""
- KILL ^DGMT(408.31,"B",$EXTRACT(X,1,30),DA)
- +43 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +44 IF X'=""
- KILL ^DGMT(408.31,"AS",+$PIECE(^DGMT(408.31,DA,0),U,19),+$PIECE(^(0),U,3),-X,+$PIECE(^(0),U,2),DA)
- +45 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +46 IF X'=""
- KILL ^DGMT(408.31,"AID",+$PIECE(^DGMT(408.31,DA,0),U,19),+$PIECE(^(0),U,2),-X,DA)
- +47 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +48 IF X'=""
- KILL ^DGMT(408.31,"AD",+$PIECE(^DGMT(408.31,DA,0),U,19),+$PIECE(^(0),U,2),X,DA)
- +49 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +50 IF X'=""
- KILL ^DGMT(408.31,"ADFN"_$PIECE(^DGMT(408.31,DA,0),U,2),X,DA)
- END QUIT
