- PSSJXR22 ; COMPILED XREF FOR FILE #55 ; 10/05/22
- ;
- S DIKZK=1
- S DIKZ(0)=$G(^PS(55,DA,0))
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" S ^PS(55,"B",$E(X,1,30),DA)=""
- S X=$P($G(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($G(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($G(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($G(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($G(DIKZ("SAND")),U,1)
- I X'="" S ^PS(55,"ASAND",DA)=""
- S X=$P($G(DIKZ("SAND")),U,1)
- I X'="" S ^PS(55,"ASAND1",$E(X,1,30),DA)=""
- CR1 S DIXR=816
- K X
- S X(1)=$P(DIKZ(0),U,7)
- S X=$G(X(1))
- I $G(X(1))]"" D
- . K X1,X2 M X1=X,X2=X
- . D LOGDFN^PSUHL(DA)
- CR2 K X
- END G ^PSSJXR23
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSJXR22 906 printed Mar 13, 2025@21:36:55 Page 2
- PSSJXR22 ; COMPILED XREF FOR FILE #55 ; 10/05/22
- +1 ;
- +2 SET DIKZK=1
- +3 SET DIKZ(0)=$GET(^PS(55,DA,0))
- +4 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +5 IF X'=""
- SET ^PS(55,"B",$EXTRACT(X,1,30),DA)=""
- +6 SET X=$PIECE($GET(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($GET(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($GET(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($GET(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($GET(DIKZ("SAND")),U,1)
- +16 IF X'=""
- SET ^PS(55,"ASAND",DA)=""
- +17 SET X=$PIECE($GET(DIKZ("SAND")),U,1)
- +18 IF X'=""
- SET ^PS(55,"ASAND1",$EXTRACT(X,1,30),DA)=""
- CR1 SET DIXR=816
- +1 KILL X
- +2 SET X(1)=$PIECE(DIKZ(0),U,7)
- +3 SET X=$GET(X(1))
- +4 IF $GET(X(1))]""
- Begin DoDot:1
- +5 KILL X1,X2
- MERGE X1=X,X2=X
- +6 DO LOGDFN^PSUHL(DA)
- End DoDot:1
- CR2 KILL X
- END GOTO ^PSSJXR23
