- PSJXR511 ; COMPILED XREF FOR FILE #55 ; 10/28/97
- ;
- S DIKZK=1
- S DIKZ(0)=$G(^PS(55,DA,0))
- S X=$P(DIKZ(0),U,1)
- I X'="" S ^PS(55,"B",$E(X,1,30),DA)=""
- S X=$P(DIKZ(0),U,1)
- I X'="" I '$D(PSGINITF) S ^PS(55,"ALCNVRT")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")
- S X=$P(DIKZ(0),U,1)
- I X'="" I '$D(PSGINITF) S ^PS(55,"AUDDD")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")
- S X=$P(DIKZ(0),U,1)
- I X'="" I '$D(PSGINITF) S ^PS(55,"AUDAPM")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")
- S X=$P(DIKZ(0),U,4)
- I X'="" S ^PS(55,"ADIA",$E(X,1,30),DA)=""
- S DIKZ("SAND")=$G(^PS(55,DA,"SAND"))
- S X=$P(DIKZ("SAND"),U,1)
- I X'="" S ^PS(55,"ASAND",DA)=""
- S X=$P(DIKZ("SAND"),U,1)
- I X'="" S ^PS(55,"ASAND1",$E(X,1,30),DA)=""
- END G ^PSJXR512
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJXR511 742 printed Mar 13, 2025@21:14:12 Page 2
- PSJXR511 ; COMPILED XREF FOR FILE #55 ; 10/28/97
- +1 ;
- +2 SET DIKZK=1
- +3 SET DIKZ(0)=$GET(^PS(55,DA,0))
- +4 SET X=$PIECE(DIKZ(0),U,1)
- +5 IF X'=""
- SET ^PS(55,"B",$EXTRACT(X,1,30),DA)=""
- +6 SET X=$PIECE(DIKZ(0),U,1)
- +7 IF X'=""
- IF '$DATA(PSGINITF)
- SET ^PS(55,"ALCNVRT")=$SELECT($DATA(^PS(59.7,1,20)):$PIECE(^(20),"^"),1:"")
- +8 SET X=$PIECE(DIKZ(0),U,1)
- +9 IF X'=""
- IF '$DATA(PSGINITF)
- SET ^PS(55,"AUDDD")=$SELECT($DATA(^PS(59.7,1,20)):$PIECE(^(20),"^"),1:"")
- +10 SET X=$PIECE(DIKZ(0),U,1)
- +11 IF X'=""
- IF '$DATA(PSGINITF)
- SET ^PS(55,"AUDAPM")=$SELECT($DATA(^PS(59.7,1,20)):$PIECE(^(20),"^"),1:"")
- +12 SET X=$PIECE(DIKZ(0),U,4)
- +13 IF X'=""
- SET ^PS(55,"ADIA",$EXTRACT(X,1,30),DA)=""
- +14 SET DIKZ("SAND")=$GET(^PS(55,DA,"SAND"))
- +15 SET X=$PIECE(DIKZ("SAND"),U,1)
- +16 IF X'=""
- SET ^PS(55,"ASAND",DA)=""
- +17 SET X=$PIECE(DIKZ("SAND"),U,1)
- +18 IF X'=""
- SET ^PS(55,"ASAND1",$EXTRACT(X,1,30),DA)=""
- END GOTO ^PSJXR512
